To add the GetOpenFilename method to Excel for Windows
Add a standard module to the Microsoft Visual Basic for Applications (VBA) project in your workbook. Type Alt+F11 to open the Visual Basic Editor, click Insert, and then click Module.
Paste or type the following macro into the module.
When you want to add more filters, you can use the following code in the macro to filter on .xls and .csv files.
Sub Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
' Save the current directory.
SaveDriveDir = CurDir
' Set the path to the folder that you want to open.
MyPath = Application.DefaultFilePath
' You can also use a fixed path.
'MyPath = "C:\Users\Ron de Bruin\Test"
' Change drive/directory to MyPath.
ChDrive MyPath
ChDir MyPath
' Open GetOpenFilename with the file filters.
Fname = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xls), *.xlsx", _
Title:="Select a file or files", _
MultiSelect:=True)
' Perform some action with the files you selected.
If IsArray(Fname) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For N = LBound(Fname) To UBound(Fname)
' Get only the file name and test to see if it is open.
FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
If bIsBookOpen(FnameInLoop) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Fname(N))
On Error GoTo 0
If Not mybook Is Nothing Then
MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
"And after you press OK, it will be closed" & vbNewLine & _
"without saving. You can replace this line with your own code."
mybook.Close SaveChanges:=False
End If
Else
MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
' Change drive/directory back to SaveDriveDir.
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
When you want to add more filters, you can use the following code in the macro to filter on .xls and .csv files.
Fname = Application.GetOpenFilename( _
FileFilter:="XLS Files (*.xls),*.xls,CSV Files (*.csv),*.csv", _
Title:="Select a file or files", _
MultiSelect:=True)
Type Alt +Q to close the Visual Basic Editor.
Type Alt + F8 to open the macro dialog box and run the macro.