How to Configure VBA to open only excel files - excel

I have a worbook that copy information from differents workbooks.
To open these workbooks I use the code below:
Dim nomearq As String
Dim nomearq2 As String
nomearq = Application.GetOpenFilename
Workbooks.Open Filename:=nomearq
nomearq2 = ActiveWorkbook.Name
So, I was trying to not allow the macro run if the selected file isn't a excel file:
If Not Right(nomearq, 4) = ".xls" Or Right(nomearq, 5) = ".xlsm" Then
MsgBox "Arquivo incompatível"
Exit Sub
But the xlsm files aren't openning. I can't wondering why.

As an alternative, you can limit the user to only being able to select Excel files, like so:
Sub tgr()
Dim nomearq As Variant
nomearq = Application.GetOpenFilename("Excel Files, *.xl??") 'This specifies that it can ONLY open Excel files
If VarType(nomearq) = vbBoolean Then Exit Sub 'Pressed cancel
With Workbooks.Open(nomearq)
'do stuff with the workbook here
MsgBox "opened " & nomearq
.Close SaveChanges:=False 'Close the opened workbook when you're done with it
End With
End Sub

The problem is with your Or logic:
If Not Right(nomearq, 4) = ".xls" Or Right(nomearq, 5) = ".xlsm" Then
This statement is actually two statements, add parentheses to see what's happening:
If (Not Right(nomearq, 4) = ".xls") Or (Right(nomearq, 5) = ".xlsm") Then
You can add the appropriate Not logic, or, instead of using Application.GetOpenFilename you should use Application.FileDialog which has parameters that allow you to restrict the file type.
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb", 1
.FilterIndex = 1
.Show
If .SelectedItems.Count > 0 Then
nomearq = .SelectedItems(0)
End If
End With
If you don't want to use FileDialog, then you can make your logic a bit more foolproof:
Dim extPos as Integer
extPos = InstrRev(nomearq, ".")
If Not Right(nomearq, extPos) Like ".xls*" Then
This should handle XlS, XLSM, XLSX, XLSB etc. file extensions.

Related

Save active worksheet as Excel Binary

How may I tweak the code below to 1) Only Save the Active Worksheet (instead of entire Workbook) and 2) Save the file as an Excel Binary file?
I'm breaking my head over this... Many thanks
Dim FileName As String
FileName = Range("B2").Value
Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogSaveAs)
With fPth
.initialFilename = FileName
.Title = "Save your File"
.FilterIndex = 2
.InitialView = msoFileDialogViewList
If .Show <> 0 Then
ThisWorkbook.SaveAs FileName:=.SelectedItems(1), FileFormat:=xlExcel12
End If

Save a new Excel file to a user-given path with FileDialog (msoFileDialogSaveAs)

I would like to save Sheet1 of ActiveWorkbook in a new book, the path will be given by the user and the name will be given by me, and then close the new book.
First, I create the copy of the sheet in a new book: ActiveWorkbook.Sheets("Sheet1").Copy and then call FileDialog (msoFileDialogSaveAs). But this saves ActiveWorkbook with the new name and leaves the newly created book unsaved and Workbooks(FileName & ".xlsm").Close gives error.
What am I doing wrong?
Option Explicit
Sub Save_As()
ActiveWorkbook.Sheets("Sheet1").Copy
Dim Time As String
Time = Format(Now, "ddmmyyyy_hhmmss")
Dim FileName As String
FileName = ActiveWorkbook.Name & "_" & Time
Dim ObFD As FileDialog
Set ObFD = Application.FileDialog(msoFileDialogSaveAs)
With ObFD
.Title = "Choose a path and export this file"
.ButtonName = "E&xport"
ObFD.InitialFileName = "C:\" & FileName
ObFD.FilterIndex = 2
ObFD.InitialView = msoFileDialogViewDetails
If ObFD.Show <> 0 Then
ObFD.Execute
Application.DisplayAlerts = False
Workbooks(FileName & ".xlsm").Close
Application.DisplayAlerts = True
End If
End With
End Sub
First retrieve the path and filename using the SelectedItems property of the FileDialog object. Then save the workbook using the SaveAs method of the Workbook object, and then close it using the Close method of the Workbook object.
Other Suggestions
1) Turn ScreenUpdating off at the beginning of your macro so that everything happens in the background, and makes things more efficient. Then turn it back on again at the end.
2) Prompt the user to select a path before creating a copy of the worksheet. Otherwise, you'll be left with a newly created workbook if the user cancels.
3) There's no need to specify ObFD within the With/End With statement, since the statement already refers to ObFD. So, for example, you should use .InitialFileName instead of ObFD.InitialFilename.
4) Avoid naming your vairable Time, since VBA has a function named Time.
Here's your macro, which has been amended accordingly...
Option Explicit
Sub Save_As()
Application.ScreenUpdating = False
Dim MyTime As String
MyTime = Format(Now, "ddmmyyyy_hhmmss")
Dim FileName As String
FileName = ActiveWorkbook.Name & "_" & MyTime
Dim ObFD As FileDialog
Set ObFD = Application.FileDialog(msoFileDialogSaveAs)
With ObFD
.Title = "Choose a path and export this file"
.ButtonName = "E&xport"
.InitialFileName = "C:\" & FileName
.FilterIndex = 2
.InitialView = msoFileDialogViewDetails
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
Dim PathAndFilename As String
PathAndFilename = .SelectedItems(1)
End If
End With
ActiveWorkbook.Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs FileName:=PathAndFilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

I'm trying to import a `.txt file` into a workbook from another workbook but doesn't work

Let's say i'm working on workbook A and workbook A produce a .txt file.
I also have workbook B witch contain a table that is ready to receive data from a .txt file.
i want to import the .txt fileproduce by workbook A into workbook B and i want to do so with workbook A
here's my code:
Sub result_template()
Dim FL As String
Dim wb As Workbook
Dim restemplate As Object
With Application.FileDialog(msoFileDialogFilePicker) '
.Title = "Select the log file" 'Open the file explorer
.InitialFileName = ThisWorkbook.path & "\" 'for you to select
.InitialView = msoFileDialogViewDetails 'the file you want
.AllowMultiSelect = False 'to format
.Show
If Not .SelectedItems(1) = vbNullString Then Sheets(5).Cells(36, 16).Value = .SelectedItems(1)
End With
With Application.FileDialog(msoFileDialogFilePicker) '
.Title = "Select the result template" 'Open the file explorer
.InitialFileName = ThisWorkbook.path & "\" 'for you to select
.InitialView = msoFileDialogViewDetails 'the file you want
.AllowMultiSelect = False 'to format
.Show
If Not .SelectedItems(1) = vbNullString Then FL = .SelectedItems(1)
Set restemplate = wb.OpenText(FL, 3, xlDelimited, True, True)
'Code to copy the contents of the .txt file to your table
ActiveWorkbook.Close Savechanges:=True filename:="result" & Date
End With
End Sub
I have a syntaxe error on ActiveWorkbook.Close
and have Object variable not set error on Set restemplate = wb.OpenText(FL, 3, xlDelimited, True, True)
what I'm I doing wrong?

Embedding a file into Excel through VBA damages the file

I have the following code
Private Sub btnOpenTemplate_Click()
Dim c As Range
Dim fd As Office.FileDialog, directory As String, fileName As String
Set c = Settings.Range("A1")
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Âûáåðèòå øàáëîí ÏÌÈ."
.Filters.Clear
.Filters.Add "Word 2003", "*.doc?"
If .Show = True Then
fileName = .SelectedItems(1)
End If
End With
If fileName = "" Then
Exit Sub
End If
If Dir(fileName, vbNormal) <> "" Then
If c.Worksheet.OLEObjects.Count > 0 Then
c.Worksheet.OLEObjects(1).Delete
End If
Settings.OLEObjects.Add fileName:=fileName, Link:=False, DisplayAsIcon:=True
End If
Settings.Range("A2").Value = fileName
lblTemplateFile.Caption = fileName
End Sub
Whenever it is executed, the workbook gets damaged and Excel is unable to repair and save it. What could be wrong? What I mean is that the workbook works fine just until I embed an object (Word doc) into it via the macro. Then it gets damaged.

Microsoft Access VBA import .xlsx file issues: "external Table not in the expected format"

I am trying to accomplish the following in a access VBA code:
Select a file from a folder
Convert the file from .csv to .xlsx
Import that file into a table in my Access database
I am having trouble with the last step, I am able to covert the file but on import there seems to be an issue with the file format. Getting the following error: " Run-time error'3274' "External table is not in the expected format"
Does anyone know of a possible solution?
Code:
Private Sub Command1_Click()
Dim fd As Office.FileDialog
Dim varFile As Variant
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Title = "Choose the File you would like to import"
.AllowMultiSelect = False
.InitialFileName = "Z:\location\"
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*"
.Filters.Add "All Files", "*.*"
.Filters.Add "CSV Files", "*.csv"
If .Show = True Then
For Each varFile In .SelectedItems
Dim xlApp As Object
Dim wb As Object
Dim strFile As String
Set xlApp = CreateObject("Excel.Application")
strFile = varFile
Set wb = xlApp.Workbooks.Open(strFile)
With wb
' where 56 is value of excel constant xlExcel8
.SaveAs FileName:=Replace(strFile, ".csv", ".xlsx"), FileFormat:=51
End With
'clean up
Set wb = Nothing
xlApp.Quit
Set xlApp = Nothing
MsgBox ("Your File has been converted and is currently being imported to this database") 'Should come up as a success
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=acSpreadsheetTypeExcel9, _
TableName:="C-Report", _
FileName:=varFile, _
HasFieldNames:=True
MsgBox ("Your Import has been complete") 'Should come up as a sucess message
Next
Else
'stop execution if nothing selected
MsgBox ("There has been an error with your import. Please try again.")
End
End If
End With
End Sub
In the TransferSpreadsheet, the name of the csv file is being referenced instead of the xlsx file.
Add this line just before that statement:
varFile = Left(varFile, (InStrRev(varFile, ".", -1, vbTextCompare) - 1)) & ".xlsx"
It will then see the proper filename and complete the transfer successfully.

Resources