Excel VBA：将多个工作簿合并为一个工作簿
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/31313377/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA: Combine multiple workbooks into one workbook
提问by SMORF
I have used the following script to copy multiple workbooks (sheets 1 only) into one master workbook. But, as multiple files are saved in the source folder each day, I now have hundreds of files in my source folder and would like to refine the folders that I copy to the master file.
我使用以下脚本将多个工作簿（仅限第 1 页）复制到一个主工作簿中。但是，由于每天在源文件夹中保存多个文件，我现在在源文件夹中有数百个文件，并且想要优化我复制到主文件的文件夹。
I there a way to restrict the folders by using a date that appears in the file names. File path is ALWAYS the same format ...
我有一种方法可以通过使用出现在文件名中的日期来限制文件夹。文件路径总是相同的格式...
5 alpha characters __ the date the file was saved (dateformat: ddmmyy) __ Julian Date
5 个字母字符 __ 文件保存日期（日期格式：ddmmyy）__ Julian Date
e.g.
例如
NOCSR__060715__162959
NOCSR__060715__162959
SBITT__060715__153902
SBITT__060715__153902
LVECI__030715__091316
LVECI__030715__091316
Can I use the date in the file path and allow the user the input 'from' and 'to' dates? The master workbook would then only pull data from files that were saved within the date range.
我可以使用文件路径中的日期并允许用户输入“from”和“to”日期吗？然后，主工作簿将仅从保存在日期范围内的文件中提取数据。
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
Thanks, SMORF
谢谢，SMRF
采纳答案by SMORF
Im not sure you need to save the date in the file name. You can read the date created property of a file with this function...
我不确定您是否需要在文件名中保存日期。您可以使用此功能读取文件的创建日期属性...
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
(pinched from here http://www.mrexcel.com/forum/excel-questions/73458-read-external-file-properties-date-created-using-visual-basic-applications.html)
Then you could write a function that takes a start date and end date and returns a list of filenames...
然后你可以编写一个函数，它接受一个开始日期和结束日期并返回一个文件名列表......
