Excel VBA: Как открыть и прочитать из файла excel

Question

Редактировать: После user3561813 предложение добавить "/", теперь он читает первый файл. У меня есть сообщение об ошибке "9". Он правильно читает первый файл. В конечном итоге я пытаюсь открыть каждый файл и прочитать имя и возраст (это тестирование не является реальной производственной формой). И верните значения обратно на мой основной рабочий лист.

Оригинальный вопрос

Я пытаюсь читать сотни первенствовать форм в папке, прочитать определенную позицию клеток, и записать их в моем тестирования листа. Я искал этот учебник и попытался написать свой код. Но когда я выполняю функцию «Получение папок», выбираю путь к папке, он не зацикливает файлы excel, которые у меня есть. (Или записать их имена)

'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

В вашем коде переменная path не может содержать обратную косую черту. Это приводит следующий код в вашем LoopFiles(<>) подпрограммы быть неточным:

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

Имени файла будет выглядеть примерно так: c:\users\name\documentshello.xlsx

Попробуйте изменить приведенный выше код:

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

ли это исправить проблему ?

Answer 2

Интересный вопрос! Это должно сделать это за вас. При необходимости измените.

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