Excel VBA：将多个工作簿合并到一个工作簿中

我已使用以下脚本将多个工作簿（仅第1页）复制到一个主工作簿中。但是，由于每天都有多个文件保存在源文件夹中，因此我现在的源文件夹中有数百个文件，我希望优化复制到主文件的文件夹

我想通过使用文件名中显示的日期来限制文件夹。文件路径始终是相同的格式

5个字母字符uu文件保存日期（日期格式：ddmmyy）uuu朱利安日期

e、 g

NOCSR_uuu060715_uuu162959

SBITT_uuu060715_uuuu153902

LVECI_uuu030715_uuuu091316

我可以使用文件路径中的日期并允许用户输入“开始”和“结束”日期吗？然后，主工作簿将仅从保存在日期范围内的文件中提取数据

Sub MergeFilesWithoutSpaces()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer
ThisWB = ActiveWorkbook.Name

path = "K:\UKSW CS Bom Expections\CS_BOM_Corrections\Archive"

RowofCopySheet = 2

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
    If Not Filename = ThisWB Then
        Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
        Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
        Set Dest = shtDest.Range("A" & shtDest.Cells(Rows.Count, 1).End(xlUp).Row + 1)
        CopyRng.Copy
        Dest.PasteSpecial xlPasteFormats
        Dest.PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False 'Clear Clipboard
        Wkb.Close False
    End If

    Filename = Dir()
Loop

---

谢谢，SMORF

我不确定您是否需要将日期保存在文件名中。您可以使用此函数读取文件的date created属性

Sub GetDateCreated()

Dim oFS As Object
Dim strFilename As String

'Put your filename here
strFilename = "c:\excel stuff\commandbar info.xls"


'This creates an instance of the MS Scripting Runtime FileSystemObject class
Set oFS = CreateObject("Scripting.FileSystemObject")

MsgBox strFilename & " was created on " & oFS.GetFile(strFilename).DateCreated



Set oFS = Nothing

End Sub

（从这里掐）

然后您可以编写一个函数，该函数接受开始日期和结束日期，并返回文件名列表