Excel VB Open File OSX and Windows

13,855

Answer can be found here - http://msdn.microsoft.com/en-us/library/office/hh710200%28v=office.14%29.aspx

Code is as follows,

OSX

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:"

    ' In the following statement, change true to false in the line "multiple 
    ' selections allowed true" if you do not want to be able to select more 
    ' than one file. Additionally, if you want to filter for multiple files, change 
    ' {""com.microsoft.Excel.xls""} to 
    ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
    ' if you want to filter on xls and csv files, for example.
    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 the file name only and test to see 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 skipped 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

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

Windows

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 97-2003 Files (*.xls), *.xls", _
            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

Picker Function

Sub WINorMAC()
' Test for the operating system.
    If Not Application.OperatingSystem Like "*Mac*" Then
        ' Is Windows.
        Call Select_File_Or_Files_Windows
    Else
        ' Is a Mac and will test if running Excel 2011 or higher.
        If Val(Application.Version) > 14 Then
            Call Select_File_Or_Files_Mac
        End If
    End If
End Sub
Sub WINorMAC_2()
' Test the conditional compiler constants.
    #If Win32 Or Win64 Then
        ' Is Windows.
        Call Select_File_Or_Files_Windows
    #Else
        ' Is a Mac and will test if running Excel 2011 or higher.
        If Val(Application.Version) > 14 Then
            Call Select_File_Or_Files_Mac
        End If
    #End If
End Sub
Share:
13,855
Flatlyn
Author by

Flatlyn

Updated on June 27, 2022

Comments

  • Flatlyn
    Flatlyn almost 2 years

    I've got a spreadsheet that uses some basic code to get the user to select a file (txt file). It works flawlessly on Windows but fails on OSX obviously due to the difference in FileDialog calls. I've done some research though and can't seem to find much information about opening a File Dialog on both OSX and Windows for Excel/VB.

    The current code is,

    FileToOpen = Application.GetOpenFilename _
    (Title:="Please choose a file to import", _
    FileFilter:="Excel Files *.xls (*.xls),")
    ''
    If FileToOpen = False Then
    MsgBox "No file specified.", vbExclamation, "Duh!!!"
    Exit Sub
    Else
    Workbooks.Open Filename:=FileToOpen
    End If