Как редактировать несколько файлов excel, каждый из которых находится в другой папке, объединенной в одну папку

Question

Этот вопрос не должен быть сложным. У меня есть одна большая папка, и в ней есть 200 отдельных папок. Теперь у каждой из этих папок есть один лист excel. Я хочу иметь некоторый код в файле vba в управляющей папке (которая находится рядом с 200), которая может перебирать более 200 папок и изменять один бит данных в каждом файле excel. Я нашел файлы каталогов и итерации папок, но я не могу взять бит для здесь и там и объединить их вместе, мне нужна простая помощь.

мой код в настоящее время: `Sub Button1_Click()

Dim wb  As Workbook 
Dim ws  As Excel.Worksheet 
Dim iIndex As Integer 
Dim strPath As String 
Dim strFile As String 

'Get the directories 
strPath = "C:\Users\generaluser\Desktop\testing main folder\" 
strFile = Dir(strPath, vbDirectory) 

'Loop through the dirs 
Do While strFile <> "" 

    'Open the workbook. 
    strFileName = Dir(strPath & strFile & "New Microsoft Excel Worksheet.xlsm", vbDirectory) 
    'Open the workbook. 
    Set wb = Workbooks.Open(Filename:=strPath & strFile & "\" & strFileName, ReadOnly:=False) 

    'Loop through the sheets. 

    Set ws = Application.Worksheets(1) 

    'Do whatever 



    'Close the workbook 
    wb.Close SaveChanges:=True 

    'Move to the next dir. 
    strFile = Dir 
Loop 

End Sub `

Пожалуйста, помогите @MatthewD

Answer 1

Поскольку вы не показать код, это что-то вроде этого.

Dim wb  As Workbook 
    Dim ws  As Excel.Worksheet 
    Dim iIndex As Integer 
    Dim strPath As String 
    Dim strFile As String 

    'Get the directories 
    strPath = "c:\temp\" 
    strFile = Dir(strPath, vbDirectory) 

    'Loop through the dirs 
    Do While strFile <> "" 

     'Open the workbook. 
     Set wb = Workbooks.Open(filename:=strPath & strFile & "\filename.xlsx", ReadOnly:=True) 

     'Loop through the sheets. 
     For iIndex = 1 To Application.Worksheets.count 
      Set ws = Application.Worksheets(iIndex) 

      'Do whatever 

     Next iIndex 

     'Close the workbook 
     wb.Close SaveChanges:=False 

     'Move to the next dir. 
     strFile = Dir 
    Loop 

Если имена книг неизвестны, вам нужно будет записать файл xlsx в каталог.

strFileName = Dir(strPath & strFile & "*.xlsx") 
    'Open the workbook. 
    Set wb = Workbooks.Open(filename:=strPath & strFile & "\" & strFileName , ReadOnly:=True) 

Answer 2

Хорошо, это должно быть довольно легко. Просто перечислите каждый файл во всех папках, рекурсивно. Ниже приведен скрипт для вас.

Sub ListAllFiles() 
    SearchForFiles "C:\Users\rshuell001\Desktop\YourFolder\", "writefilestosheet", "*.*", True, True 
End Sub 

Sub searchForFiles(ByVal DirToSearch As String, ByVal ProcToCall As String, _ 
     Optional ByVal FileTypeToFind As String = "*.*", _ 
     Optional ByVal SearchSubDir As Boolean = False, _ 
     Optional ByVal FilesFirst As Boolean = False) 
    On Error GoTo ErrXIT 
    If Right(DirToSearch, 1) <> Application.PathSeparator Then _ 
     DirToSearch = DirToSearch & Application.PathSeparator 

If FilesFirst Then processFiles DirToSearch, ProcToCall, FileTypeToFind 
If SearchSubDir Then processSubFolders DirToSearch, ProcToCall, _ 
    FileTypeToFind, SearchSubDir, FilesFirst 

    If Not FilesFirst Then _ 
     processFiles DirToSearch, ProcToCall, FileTypeToFind 
    Exit Sub 
ErrXIT: 
    MsgBox "Fatal error: " & Err.Description & " (Code=" & Err.Number & ")" 
    Exit Sub 
End Sub 


Private Sub processFiles(ByVal DirToSearch As String, _ 
      ByVal ProcToCall As String, _ 
      ByVal FileTypeToFind As String) 
     Dim aFile As String 
     aFile = Dir(DirToSearch & FileTypeToFind) 
     Do While aFile <> "" 
      Application.Run ProcToCall, DirToSearch & aFile 
      aFile = Dir() 
      Loop 
End Sub 


Sub writeFilesToSheet(ByVal aFilename As String) 
    With ActiveSheet 
    .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = aFilename 
     End With 
End Sub 

Далее, как вы осознаете, вам необходимо получить доступ к каждому файлу, используя технику выше, откройте каждый, сделать ваши изменения, сохраните его и закройте файл. Используйте изменения, описанные в приведенном ниже URL, чтобы внести изменения.

http://www.rondebruin.nl/win/s3/win010.htm

Вам придется изменить сценарий только немного, потому что ищет все файлы на одну папке, вам нужен сценарий Рона пробежать, созданные с первым сценарием различных путями