按顺序合并文件

Question

我有下面的vba宏用来合并多个文件。但是，当im合并文件时，它们不会按照我的文件夹为该路径设置的顺序进行合并。谁能告诉我怎样才能让我的文件按顺序合并？

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