时间戳

首页 > 解决方案 > VBA从各种文件中收集数据->在文件夹中找不到文件

excel - VBA从各种文件中收集数据->在文件夹中找不到文件

问题描述

我需要从各种 Excel 文件中收集数据并将它们汇总到一个“主文件”中。使用下面提供的代码，我可以随心所欲地做到这一点。此主文件位于我尝试收集和汇总的文件之外的其他文件夹中。但是，保存代码后，关闭 excel 文件并重新打开它以检查它是否第二次工作，出现错误。该错误表明无法找到某个文件并且代码立即停止。我想知道怎么可能一切都很好，而在第二次尝试时它根本不起作用。

有问题的代码行是：“With Workbooks.Open(Filename:=QuellDateiAktuell$)”

第二个问题 - 这很好，所以不需要额外工作，如果你没有解决方案 - 是否有可能根据文件的最后 15 位在 excel 文件中命名工作表数据分别来自哪里？

提前非常感谢，我很绝望！

        ''' 
        Sub Collect Data ()
        Dim Folder$             ('this is where the aggregated data should be visible)
        Dim QuellDateien$, QuellDateiAktuell$ ('first one the folder where the data is at the moment; 
                                                the second one, each file with data within this current folder)
        Dim wbkZiel As Workbook

        With Application
        .ScreenUpdating = False
        .EnableEvents = False
        End With
        
        Folder$ = "W:\...\test.xlsm"
        QuellDateien$ = "W:\(every file in this last folder with the following ending:)\*.xlsb"
        
        'Open folder and open the first file from where the data should be collected
        Set wbkZiel = Workbooks.Open(Filename:=Folder$)
        QuellDateiAktuell$ = Dir(PathName:=QuellDateien$)

        'Loop to check, if there are other files
        Do Until Len (QuellDateiAktuell$) = 0

        'Open the files, copy Sheet1 and close the file
        
        '......AN ERROR OCCURS IN THE FOLLOWING, NAMELY "File cannot be found! ALTOUGH THERE IS A                         
         FILE ACTUALLY"......

        With Workbooks.Open(Filename:=QuellDateiAktuell$)
        .Sheets(1).Copy After:=wbkZiel.Sheets(1)
        .Close savechanges:=False
        End With

        'get the next folder and so on
        QuellDateiAktuell$ = Dir ()

        Loop

        With Application
        .ScreenUpdation = True
        .EnableEvents = True
        End With

        End Sub
'''

标签： excelvbaaggregate

解决方案

Dir 只返回文件名和扩展名。您需要重新附加目录路径才能打开文件。

Function FileOpen(ByVal Directory As String, ByVal Name_Format As String) As Workbook
    Dim FileName As String
    FileName = Dir(Directory & Name_Format)
    Set FileOpen = Application.Workbooks.Open(Directory & FileName) '<- I add the directory again
End Function

推荐阅读