Excel VB Open File OSX and Windows

后端 未结 1 1451
野趣味
野趣味 2021-01-03 11:06

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 differenc

相关标签:
1条回答
  • 2021-01-03 11:40

    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
    
    0 讨论(0)
提交回复
热议问题