Excel VBA: Combine multiple workbooks into one workbook

29,697

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...

Share:
29,697
SMORF
Author by

SMORF

Updated on July 09, 2020

Comments

  • SMORF
    SMORF almost 4 years

    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.

    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

    e.g.

    NOCSR__060715__162959

    SBITT__060715__153902

    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.

    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