Excel VBA:将多个工作簿组合到一个工作簿中

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

我有一种方法通过使用文件名中显示的date来限制文件夹。 文件path始终是相同的格式…

5个字母字符__文件的保存date(dateformat:ddmmyy)__ Juliandate

例如

NOCSR__060715__162959

SBITT__060715__153902

LVECI__030715__091316

我可以在文件path中使用date,并允许用户input“from”和“to”date吗? 然后主工作簿将只从date范围内保存的文件中提取数据。

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的文件名。 您可以使用此function读取文件的date创build属性…

 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 

(捏从这里http://www.mrexcel.com/forum/excel-questions/73458-read-external-file-properties-date-created-using-visual-basic-applications.html

然后,你可以写一个函数,该函数需要一个开始date和结束date,并返回一个文件名列表…