Friday, February 24, 2012

Select files on a Mac (GetOpenFilename)

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

No comments:

Post a Comment