Question

我有以下vba宏来合并多个文件。但是，当我合并文件时，它们不会按照我的文件夹设置为该路径的顺序合并。有人可以告诉我如何让我的文件按顺序合并吗？

Dim booklist As Workbook   
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False  
Set mergeObj = CreateObject("Scripting.FileSystemObject")

Set dirObj = mergeObj.Getfolder("PATH")  
Set filesObj = dirObj.Files  
For Each everyObj In filesObj  
Set booklist = Workbooks.Open(everyObj)

Range("A1:H27").Copy  
ThisWorkbook.Worksheets(1).Activate

Range("A65536").End(xlUp).Offset(2, 0).PasteSpecial  
Application.CutCopyMode = False  
booklist.Close  
Next

Rows("1:1").Select  
Selection.Delete Shift:=xlUp  
Rows("1:1").Select  
Selection.Delete Shift:=xlUp  
Range("A1").Select

End Sub

Answer 1

文件将始终以VBA代码中的随机顺序显示。要设置自己的排序顺序，可以使用.Folder及其属性来定义它。查看MSDN - Folder Object的文档，然后查看Items.Sort Method的文档。

或者，您可以读入所有文件名，并在CodingHorror中讨论的基于VBA的数组中对它们进行排序。

Answer 2

我的解决方案适用于需要在这些文件创建顺序中将excel文件合并到一个文件中的情况。

Sub Main()


Dim sourceWorkbook As Workbook
Dim FSO As Object
Dim sourceFolder As Object
Dim file As Object
Dim templatePath As String, templateName As String, sourceFolderPath As String
Dim destinationFileNamePrefix As String, destinationFolderPath As String
Dim moveMergedFilesToBackup As Boolean, backupUpperFolderPath As String
Dim lastTemplateColumn As Integer, fullyFilledColumnNumber As Integer, lastSourceFileColumn As Integer, sourceFileName As String
Dim lastRow As Long, i As Long, insertExecutionNumber As Boolean, executionNumber As Long
Dim sortingWorkbook As Workbook, rowNo As Long, lastArrayIndex As Long, sourceFilesPathArray() As String

Application.ScreenUpdating = False

Call LoadSettings.LoadDataFromControlSheet(templatePath, sourceFolderPath, fullyFilledColumnNumber, destinationFolderPath, _
        destinationFileNamePrefix, moveMergedFilesToBackup, backupUpperFolderPath, insertExecutionNumber)

Workbooks.Open fileName:=templatePath
templateName = Right(templatePath, Len(templatePath) - InStrRev(templatePath, "\"))
Workbooks(templateName).Activate
Call SaveFiles.SaveTemplateToTemporaryFolder(templateName)
lastTemplateColumn = Range("A1").End(xlToRight).Column


Set FSO = CreateObject("Scripting.FileSystemObject")
Set sourceFolder = FSO.Getfolder(sourceFolderPath)

'Create a new workbook for files sorting in ascending order according their creation date
Set sortingWorkbook = Workbooks.Add
'sortingWorkbook.Name = "SortingWorkbook.xlsx"
'Call SaveFiles.SaveTemplateToTemporaryFolder(sortingWorkbook.Name)
sortingWorkbook.Activate
Range("A1") = "File path"
Range("B1") = "Creation Date and Time"
'Write required data into sorting workbook
rowNo = 2
For Each file In sourceFolder.Files
    sourceFileName = file.Name
    If InStr(sourceFileName, ".xlsx") Then ' Only xlsx files will be merged
        Range("A" & rowNo) = file.Path
        Range("B" & rowNo) = file.DateCreated
        rowNo = rowNo + 1
    End If ' If InStr(sourceFileName, ".xlsx") Then' Only xlsx files will be merged
Next

'Sort by file creation date and time - column B
Range("A1:B1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
    ("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
'Read filepath into array
lastArrayIndex = rowNo - 3 ' rowNo at this moment is +1 than rows, data is from 2 row, array is 0 Based, so -3
ReDim sourceFilesPathArray(lastArrayIndex) 'size array
rowNo = 2
For i = 0 To lastArrayIndex
    sourceFilesPathArray(i) = Range("A" & rowNo)
    rowNo = rowNo + 1
Next i

sortingWorkbook.Close saveChanges:=False

'Open source files and merge them into accumulation template
For i = 0 To lastArrayIndex
    Set sourceWorkbook = Workbooks.Open(sourceFilesPathArray(i))
    'Check if source file headers columns number corresponds template to which will be merged data columns number
    lastSourceFileColumn = Range("A1").End(xlToRight).Column
    If lastSourceFileColumn = lastTemplateColumn Then
        lastRow = Cells(Rows.Count, fullyFilledColumnNumber).End(xlUp).Row
        Range(Cells(2, 1), Cells(lastRow, lastSourceFileColumn)).Copy
        Workbooks(templateName).Activate
        lastRow = Cells(Rows.Count, fullyFilledColumnNumber).End(xlUp).Row
        Range("A" & lastRow + 1).PasteSpecial
        Application.CutCopyMode = False
        sourceWorkbook.Close
    Else
        MsgBox "In the source directory was found xlsx format file" & vbNewLine & _
            sourceFilesPathArray(i) & vbNewLine & _
            "which has data columns number " & lastSourceFileColumn & vbNewLine & _
            "which is different from template into which data are accumulated " & vbNewLine & _
            "data columns number " & lastTemplateColumn & "." & vbNewLine & _
            "This program will end now." & vbNewLine & _
            "Check if you selected correct template and source folder or" & vbNewLine & _
            "remove incorrect source file from source folder and then" & vbNewLine & _
            "restart the program", vbCritical, ThisWorkbook.Name

        Workbooks(templateName).Close saveChanges:=False
        sourceWorkbook.Close
        End
    End If

Next i


Set sourceWorkbook = Nothing
Set filesObj = Nothing
Set FSO = Nothing




'Save accumulated in template data into destination folder with name formed by settings
Call SaveFiles.SaveMergedDataIntoDestination(templateName, destinationFileNamePrefix, destinationFolderPath)




Application.ScreenUpdating = True

End Sub

按顺序合并文件

2 个答案: