我使用以下脚本将多个工作簿(仅限工作表1)复制到一个主工作簿中。但是,由于每天都有多个文件保存在源文件夹中,我现在在源文件夹中有数百个文件,并希望优化我复制到主文件的文件夹。
我有办法使用文件名中显示的日期来限制文件夹。文件路径始终是相同的格式...
5个字母字符__保存文件的日期(dateformat:ddmmyy)__ Julian Date
e.g。
NOCSR__060715__162959
SBITT__060715__153902
LVECI__030715__091316
我可以在文件路径中使用日期并允许用户输入'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
谢谢,SMORF
答案 0 :(得分:1)
我不确定您是否需要在文件名中保存日期。您可以使用此函数读取文件的创建日期属性...
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
然后你可以编写一个函数来获取开始日期和结束日期并返回文件名列表......