Forum Discussion

Colin Lim's avatar
Colin Lim
Copper Contributor
Mar 13, 2018

Extract Data from All Files w/ a Last Modified Date Between 02/01/2018 and 02/24/2018

Hi Everyone,

 

I have a folder with Excel files that are completely standardized in terms of the type of data in specific cells. What I am hoping to be able to do is to have the VBA code only retrieve data from files that has a last modified of... for example... February 1st, 2018 to February 24th, 2018. I've figured out the VBA code for extracting the data but have not been able to figure out the VBA code for it to be discriminating in terms of the last modified date.

 

Here is what I have so far...

 

 

Public Sub GetFiles()
 On Error GoTo exitloop
 Path = "D:\Report Data\Berries\"
 NextFile = Dir(Path & "*.*")

 ' Open Excel File
 Workbooks.Open Filename:=Path & NextFile
 ' Copy/Paste Data from File
 Call ExtractData
 ' Close WorkBook and Suppress Saving Request
 ActiveWorkbook.Close False

 ' Start Loop Function
 Do While NextFile <> ""
 NextFile = Dir
 If NextFile = "" Then Exit Sub

 ' Open WorkBook
 Workbooks.Open Filename:=Path & NextFile
 ' Copy/Paste Data from File/WorkBook
 Call ExtractData
 ' Close WorkBook and Suppress Saving Request
 ActiveWorkbook.Close False

 Loop
exitloop:
 End Sub
 
Private Sub ExtractData()
' Specify WorkSheet name below in quotes
 TargetSh = "Berries Composite Data"

 With ThisWorkbook.Sheets(TargetSh)
' Places Curser in Last Row
 NxtEmptyRw = .Cells(65536, 1).End(xlUp).Row + 1
' Be sure to place number after the comma of NxEmptyRw serially and sequentially so as not to override data.
.Cells(NxtEmptyRw, 1).Value = ActiveWorkbook.Worksheet("Phase01").Range("C6").Value
.Cells(NxtEmptyRw, 2).Value = ActiveWorkbook.Worksheet("Phase01").Range("C8").Value
.Cells(NxtEmptyRw, 3).Value = ActiveWorkbook.Worksheet("Phase01").Range("W7").Value
.Cells(NxtEmptyRw, 4).Value = ActiveWorkbook.Worksheet("Phase01").Range("W3").Value
.Cells(NxtEmptyRw, 5).Value = ActiveWorkbook.Worksheet("Phase01").Range("Y4").Value
 End With
 End Sub

 

 

Your guidance is greatly appreciated. Please let me know if you have any questions.

Macros & VBA
VBA

2 Replies

Sort By
  • Matt Mickle's avatar
    Matt Mickle
    Bronze Contributor
    Mar 13, 2018

    Try editing your code to look like this....

     

    Please note you need to adjust the lines that say "YOUR DATE HERE":

     

    Public Sub GetFiles()
 On Error GoTo exitloop
 Path = "D:\Report Data\Berries\"

 ' Start Loop Function
 
NextFile = Dir(fpath & "*.xls*")
 Do While NextFile <> ""
 
       myModifyDate = FileLastModified(Path & NextFile)
        If myModifyDate > "YOUR DATE HERE" And myModifyDate < "YOUR DATE HERE" Then
            ' Open WorkBook
            Workbooks.Open Filename:=Path & NextFile
            ' Copy/Paste Data from File/WorkBook
            Call ExtractData
            ' Close WorkBook and Suppress Saving Request2
            ActiveWorkbook.Close False
        End If

    NextFile = Dir
 Loop
exitloop:
 End Sub
 
Private Sub ExtractData()
' Specify WorkSheet name below in quotes
 TargetSh = "Berries Composite Data"
    
     With ThisWorkbook.Sheets(TargetSh)
        ' Places Curser in Last Row
         NxtEmptyRw = .Cells(65536, 1).End(xlUp).Row + 1
        ' Be sure to place number after the comma of NxEmptyRw serially and sequentially so as not to override data.
        .Cells(NxtEmptyRw, 1).Value = ActiveWorkbook.Worksheet("Phase01").Range("C6").Value
        .Cells(NxtEmptyRw, 2).Value = ActiveWorkbook.Worksheet("Phase01").Range("C8").Value
        .Cells(NxtEmptyRw, 3).Value = ActiveWorkbook.Worksheet("Phase01").Range("W7").Value
        .Cells(NxtEmptyRw, 4).Value = ActiveWorkbook.Worksheet("Phase01").Range("W3").Value
        .Cells(NxtEmptyRw, 5).Value = ActiveWorkbook.Worksheet("Phase01").Range("Y4").Value
     End With
 End Sub
 
Function FileLastModified(strFullFileName As String)
    Dim fs As Object, f As Object, s As String
     
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(strFullFileName)
    s = f.DateLastModified
    FileLastModified = s
    Set fs = Nothing: Set f = Nothing
    
End Function
  • Jamil's avatar
    Jamil
    Bronze Contributor
    Mar 13, 2018

    I assume you know the basics of the VBA, so this will get you started.

    You will need to use the Microsoft Scripting Runtime.

     

     

    Set oFile = CreateObject("Scripting.FileSystemObject")
if oFile.getFile(Directory & FileName).DateLastModified >= EarliestDate and oFile.getFile(Directory & FileName).DateLastModified <= LatestDate

Resources