Excel VB打开文件OSX和Windows
我有一个电子表格，使用一些基本的代码来让用户select一个文件（txt文件）。 它在Windows上完美地工作，但在OSX上显然由于FileDialog调用的不同而失败。 我已经做了一些研究，似乎无法find有关在Excel / VB的OSX和Windows上打开文件对话框的许多信息。
目前的代码是，
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 答案可以在这里find – 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
视窗
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
选取器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