Excel VB打開文件OSX和Windows

Question

我有一個電子表格，它使用一些基本代碼來讓用戶選擇一個文件（txt文件）。它在Windows上完美工作，但由於FileDialog調用的不同，在OSX上顯然失敗。我已經做了一些研究，似乎無法找到有關在OSX和Windows上爲Excel/VB打開文件對話框的更多信息。

當前的代碼是，

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 

Answer 1

答案可以在這裏找到 - http://msdn.microsoft.com/en-us/library/office/hh710200%28v=office.14%29.aspx

代碼如下，

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 

風OWS

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 

選擇器功能

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