Note: The macro example for Windows and Mac are both using
this function to test if the file is open.
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
In Windows you can use filefilter to only display the files you
want and
use MultiSelect to select more then one file. Also it is possible with
ChDrive and ChDir
to set the folder that is selected when GetOpenFilename opens, see basic example below :
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 current Dir
SaveDriveDir = CurDir
'Set path to the folder that you want to open
MyPath = Application.DefaultFilePath
'You can also use a fixed path like this
'MyPath = "C:\Users\Ron de Bruin\Test"
'Change Drive/Dir to MyPath
ChDrive MyPath
ChDir MyPath
'Open GetOpenFilename, there are more file filters possible
Fname = Application.GetOpenFilename( _
FileFilter:="Excel 97-2003 Files (*.xls), *.xls", _
Title:="Select a file or files", _
MultiSelect:=True)
'Do what you want 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 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 open this file : " & Fname(N) & vbNewLine & _
"And after you press OK it will be closed" & vbNewLine & _
"without saving, replace this line with your own code."
mybook.Close savechanges:=False
End If
Else
MsgBox "We skip 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/Dir back to SaveDriveDir
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
When you want to add more filters you can use this 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)
But on a Mac the filefilter is not working and it is not possible to select more
then one file.
Also ChDir is not working like in Windows to set the folder that will open
with GetOpenFilename.
But we can use a combination of VBA and Applescript, see example below that
only display
xls files
and you can set the start folder and you can select one or more then one
file:
Sub Select_File_Or_Files_Mac()
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim Fname As String
Dim mybook As Workbook
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"
MyScript = _
"set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & _
" {""com.microsoft.Excel.xls""} " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles <> "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MySplit = Split(MyFiles, ",")
For N = LBound(MySplit) To UBound(MySplit)
'Get file name only and test if it is open
Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), _
Application.PathSeparator, , 1))
If bIsBookOpen(Fname) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MySplit(N))
On Error GoTo 0
If Not mybook Is Nothing Then
MsgBox "You open this file : " & MySplit(N) & vbNewLine & _
"And after you press OK it will be closed" & vbNewLine & _
"without saving, replace this line with your own code."
mybook.Close savechanges:=False
End If
Else
MsgBox "We skip this file : " & MySplit(N) & " because it Is already open"
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Note: change true to false in this line in the code if you
not want to be able to select more then one file.
multiple selections allowed true
You can remove the Split and loop part because MyFiles is already your
answer when you set it to false.
You see that I now only filter on
xls files , other options
are :
xlsx
org.openxmlformats.spreadsheetml.sheet
xlsm
org.openxmlformats.spreadsheetml.sheet.macroenabled
xlsb
com.microsoft.Excel.sheet.binary.macroenabled
xls
com.microsoft.Excel.xls
csv
public.comma-separated-values-text
docx
org.openxmlformats.wordprocessingml.document
docm
org.openxmlformats.wordprocessingml.document.macroenabled
doc
com.microsoft.word.doc
pptx
org.openxmlformats.presentationml.presentation
pptm
org.openxmlformats.presentationml.presentation.macroenabled
ppt
com.microsoft.powerpoint.ppt
Tip : In the example file we
filter on one file type (xls) but you can filter on more file types like
this
Change
