Блог

Пытаясь заставить этот VBA в Excel открыть определенную папку, чтобы выбрать файлы Excel для объединения, я, кажется, хожу по кругу, как обычно…..

 Sub mergeFiles()
    'Merges all files in a folder to a main file.
    
    'Define variables:
    Dim numberOfFilesChosen, i As Integer
    Dim tempFileDialog As fileDialog
    Dim mainWorkbook, sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    
    Set mainWorkbook = Application.ActiveWorkbook
    Set tempFileDialog = Application.fileDialog(msoFileDialogFilePicker)
    
    'Allow the user to select multiple workbooks
    tempFileDialog.AllowMultiSelect = True
    
    numberOfFilesChosen = tempFileDialog.Show
    
    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.Count
        
        'Open each workbook
        Workbooks.Open tempFileDialog.SelectedItems(i)
        
        Set sourceWorkbook = ActiveWorkbook
        
        'Copy each worksheet to the end of the main workbook
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
        Next tempWorkSheet
        
        'Close the source workbook
        sourceWorkbook.Close
    Next i
    
End Sub
  

Любые идеи о том, как изменить код, чтобы использовать определенный путь для папки, были бы высоко оценены.

Вот надеюсь

Пожалуйста, попробуйте следующий код:

 Sub mergeFilesBis()
    'Define variables:
    Dim i As Integer, tempFileDialog As FileDialog
    Dim mainWorkbook, sourceWorkbook As Workbook, tempWorkSheet As Worksheet
    Dim initialFolder As String
    
    initialFolder = "C:"
    Set mainWorkbook = Application.ActiveWorkbook
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    
    'Allow the user to select multiple workbooks
    With tempFileDialog
        .AllowMultiSelect = True
        .InitialFileName = initialFolder
        If Not .Show = -1 Then Exit Sub
    End With
    
    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.count

        Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))
        
        'Copy each worksheet to the end of the main workbook
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            tempWorkSheet.Copy After:=mainWorkbook.sheets(mainWorkbook.Worksheets.count)
        Next tempWorkSheet
        
        'Close the source workbook
        sourceWorkbook.Close
    Next i
End Sub