Excel VBA: Öffnen und Lesen von Excel-Datei

Question

Bearbeiten: Nach user3561813 der Vorschlag zum Hinzufügen "/", liest es jetzt die erste Datei. Ich habe eine Fehlermeldung außerhalb des Bereichs "9". Es liest die erste Datei korrekt. Letztendlich versuche ich, jede Datei zu öffnen, und lese den Namen und das Alter (das ist ein Test, nicht das reale Produktionsformular). Und rufen Sie die Werte zurück zu meinem Hauptarbeitsblatt ab.

Original Frage

Ich versuche, hundert von Excel-Formulare in einem Ordner zu lesen, lesen, eine bestimmte Zelle Position und speichert sie in meinem Test-Arbeitsblatt. Ich habe dieses Tutorial gegooglet und versucht, meinen Code zu schreiben. Aber wenn ich die Funktion "Ordner holen" ausfühle, habe ich einen Ordnerpfad ausgewählt, der die Excel-Dateien, die ich habe, nicht wiederholt. (Oder notieren ihre Namen)

'Source: https://www.youtube.com/watch?v=7x1T4s8DVc0 
Sub GettingFolder() 
Dim SelectedFolder As String 

With Application.FileDialog(msoFileDialogFolderPicker) 
    .Title = "Select folder" 
    .ButtonName = "Confirm" 
    .InitialFileName = "U:\" 

    If .Show = -1 Then 
     'ok clicked 
     SelectedFolder = .SelectedItems(1) 
     MsgBox SelectedFolder 
     ' This is where I want to call my function 
     LoopFiles (SelectedFolder) 
    Else 
     'cancel clicked 
    End If 
End With 
End Sub 

' Source: http://www.excel-easy.com/vba/examples/files-in-a-directory.html 
Sub LoopFiles(path As String) 
Dim directory As String, fileName As String, sheet As Worksheet 
Dim i As Integer, j As Integer 

' Avoid Screen flicker and improve performance 
Application.ScreenUpdating = False 
' Fixed per suggestion below.. 
directory = path & "\" 
fileName = Dir(directory & "*.xl??") 

Do While fileName <> "" 
    i = i + 1 
    j = 2 
    Cells(i, 1) = fileName 
    Workbooks.Open (directory & fileName) 
    For Each sheet In Workbooks(fileName).Worksheets 
     Workbooks("Testing.xlsm").Worksheets(1).Cells(i, j).Value = sheet.Name 
     j = j + 1 
    Next sheet 
    Workbooks(fileName).Close 
    fileName = Dir() 
Loop 

' Reset the screen update setting 
Application.ScreenUpdating = True 
End Sub 

Answer 1

in Ihrem Code die path Variable kann kein Backslash enthalten. Dies bewirkt, dass der folgende Code in Ihre LoopFiles(<>) Unterroutine ungenau sein:

directory = path 
fileName = Dir(directory & "*.xl??") 

Dateiname wie etwas aussehen würde: c:\users\name\documentshello.xlsx

Versuchen Sie den obigen Code auf sich ändernde:

directory = path & "\" 
fileName = Dir(directory & "*.xl??") 

Heißt das, das Problem zu beheben ?

Answer 2

Interessante Frage! Dies sollte es für Sie tun. Ändern Sie nach Bedarf.

Sub LoopAllExcelFilesInFolder() 

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 
'SOURCE: www.TheSpreadsheetGuru.com 

Dim wb As Workbook 
Dim myPath As String 
Dim myFile As String 
Dim myExtension As String 
Dim FldrPicker As FileDialog 

'Optimize Macro Speed 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.Calculation = xlCalculationManual 

'Retrieve Target Folder Path From User 
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) 

    With FldrPicker 
     .Title = "Select A Target Folder" 
     .AllowMultiSelect = False 
     If .Show <> -1 Then GoTo NextCode 
     myPath = .SelectedItems(1) & "\" 
    End With 

'In Case of Cancel 
NextCode: 
    myPath = myPath 
    If myPath = "" Then GoTo ResetSettings 

'Target File Extension (must include wildcard "*") 
    myExtension = "*.xlsx" 

'Target Path with Ending Extention 
    myFile = Dir(myPath & myExtension) 
    Row = 1 
'Loop through each Excel file in folder 
    Do While myFile <> "" 
    'Set variable equal to opened workbook 
     Set wb = Workbooks.Open(Filename:=myPath & myFile) 

    'Change First Worksheet's Background Fill Blue 
     ThisWorkbook.Worksheets("Sheet1").Range("A" & Row).Value = Worksheets(1).Range("A1").Value 
     Row = Row + 1 
    'Save and Close Workbook 
     wb.Close SaveChanges:=True 

    'Get next file name 
     myFile = Dir 
    Loop 

'Message Box when tasks are completed 
    MsgBox "Task Complete!" 

ResetSettings: 
    'Reset Macro Optimization Settings 
    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 

End Sub