引用数千个其他已关闭的工作簿

时间:2016-11-04 19:14:43

标签: excel vba excel-vba

尝试编写一个从数千个工作簿的Cell F9中提取数据的宏。当我运行它时,我收到一个错误,说excel在引用我正在创建的链接时遇到问题。我觉得这与我调出strRng范围的方式有关,但我无法弄清楚我做错了什么。

Sub HyperlinkFileSubfoldersList() ' all levels
    Dim mydir As String, myExtension As String

    Dim t As Single
    t = Timer

    Application.ScreenUpdating = False
    mydir = "C:\Users\msala\Desktop\Pacman Statistics\"
    myExtension = "*.csv*"
    Call SearchFiles(mydir, myExtension, 0)

    Rows(1).Select
    Selection.Insert
    Range("A1") = "FILENAME"
    Range("B1") = "DATA1"
    Range("C1") = "DATA2"
    Range("D1") = "DATA3"
    Range("E1") = "DATA4"
    Range("F1") = "DATA5"
    Range("G1") = "..."

    i = 2
    Do While Range("A" & i) <> ""
        filelocation = Range("A" & i)

        strPath = Left(filelocation, Len(filelocation) - 14) 'the path must be the file location minus the file name
        strFile = Right(filelocation, 14)   '
        strSheet = Left(strFile, 10)   'Sheet name is always the name of file minus .csv

        strRng = Range("F9")

        strRef = "'" & strPath & "[" & strFile & "]" & strSheet & "'!" & strRng

        Result = ExecuteExcel4Macro(strRef)
        Range("B" & i) = Result
        i = i + 1  
    Loop

End Sub

Private Sub SearchFiles(mydir As String, myFileName As String, n As Long)
    Dim fso As Object, myFolder As Object, myFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each myFile In fso.getfolder(mydir).Files
        If (Not myFile.Name Like "~$*") _
           * (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
           * (UCase(myFile.Name) Like UCase("*" & myFileName)) Then
           n = n + 1
           Cells(n, 1) = mydir & "\" & myFile.Name
        End If
    Next

    For Each myFolder In fso.getfolder(mydir).subfolders
        Call SearchFiles(myFolder.Path, myFileName, n)
    Next

End Sub

范围是否应采用不同的格式?当我为'strRef'做一个msgbox时,它给了我(例如)'C:\mypath\[02232S0926.csv]02232S0926]'!

0 个答案:

没有答案