vba Excel VB 打开文件 OSX 和 Windows

Excel VB Open File OSX and Windows

提问by Flatlyn

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.

我有一个电子表格，它使用一些基本代码让用户选择一个文件（txt 文件）。由于 FileDialog 调用的不同，它在 Windows 上可以完美运行，但在 OSX 上显然失败了。我已经做了一些研究，但似乎找不到很多关于在 OSX 和 Windows 上为 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

回答by Flatlyn

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

答案可以在这里找到 - 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