Note: The macro example for Windows and Mac are both using
this function to test if the file is open.
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 :
When you want to add more filters you can use this in the macro to filter on xls and csv files
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:
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
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 anduse 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
No comments:
Post a Comment