Question

使用它从特定文件夹中获取excel文件。它适用于Windows操作系统，但不适用于Mac OS。如何使其跨板形式？请帮忙。

 Sub getfilename()
 Dim objFSO As Object
Dim intCountRows As Integer
Application.FileDialog(msoFileDialogFolderPicker).Title = _
"Select a Path"
intResult = Application.FileDialog( _
msoFileDialogFolderPicker).Show
If intResult <> 0 Then
    strpath = Application.FileDialog(msoFileDialogFolderPicker _
    ).SelectedItems(1)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Activate
Sheets("dropdown").Select
Range("q2").Value = strpath
End If
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strpath)
 ThisWorkbook.Activate
Sheets("dropdown").Activate
Range("aa3:aa2000").Clear
i = 1
For Each objFile In objFolder.Files
    Filename = objFile.Name      
     Range("aa1000").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    Application.ActiveCell = Filename
 Next objFile
End Sub

Answer 1

您可以查看它是什么操作系统，并为每个操作系统运行不同的代码，以解决Mac版本中特别出现的问题区域。很可能是非excel相关代码。正如@chrisneilson所提到的，特别是“Scripting.FileSystemObject”

另外，如下面的评论中所述，无论如何都会编译不可接受的代码行并导致错误，因此您需要运行代码using conditional compilation。

基本上它们只在满足条件时才编译，你可以通过在行前面使用“＃”来做到这一点，例如If语句：“＃If”

从MSDN修改：Run The Correct Macro in Windows or on the Macintosh

Sub WINorMAC()
'Test using conditional compiler constants.
    #If Win32 Or Win64 Then
        'Is a Windows user.
        Call getfilename
    #Else
        'Is a Mac user so you need to test whether the product is Excel 2011 or later.
        If Val(Application.Version) > 14 Then
            Call My_Mac_Macro  'almost getfilename, with some replacements for Mac
        End If
    #End If
End Sub

现在只需修改sub getfilename（）以包含条件编译器常量。而对Mac版本则相反，以确保没有编译错误。

Sub getfilename()
    #If Win32 Or Win64 Then
        Dim objFSO As Object
        Dim intCountRows As Integer

        Application.FileDialog(msoFileDialogFolderPicker).Title = _
            "Select a Path"
            intResult = Application.FileDialog( _
            msoFileDialogFolderPicker).Show

        If intResult <> 0 Then
            strpath = Application.FileDialog(msoFileDialogFolderPicker _
                ).SelectedItems(1)
            Set objFSO = CreateObject("Scripting.FileSystemObject")

            ThisWorkbook.Activate
            Sheets("dropdown").Select
            Range("q2").Value = strpath

        End If

        Dim objFolder As Object
        Dim objFile As Object
        Dim i As Integer

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(strpath)

        ThisWorkbook.Activate
        Sheets("dropdown").Activate
        Range("aa3:aa2000").Clear
        i = 1
        For Each objFile In objFolder.Files
            Filename = objFile.Name
             Range("aa1000").Select
            Selection.End(xlUp).Select
            ActiveCell.Offset(1, 0).Select
            Application.ActiveCell = Filename
        Next objFile
    #End If
End Sub

编辑：在评论和讨论之后修改了答案，除了检查操作系统类型外还包括条件编译器。

编码适用于Windows操作系统，但不适用于Mac OS（运行时错误1004）

1 个答案: