Create a Macro that searches a specific folder for the most recent file and pulls the information into another specific worksheet

Nilsjohanekman

New Member
Joined
Nov 19, 2016
Messages
8
Hey community,

I'm trying to create a Macro that searches a specific folder for the most recent file, opens it, and pulls out all of the data which needs to be pasted on a specific worksheet of a different excel file.

Through some research I've been able to compile the following code (I have very limited knowledge) but I'm receiving an error message. (Error Message: Run-time error '1004': 'C:\Users\nilsjohanekman\Desktop\PO Macro\PO Business Intelligence Report\11/19/2016 5:26"06PM.xlsx' could not be found. Check the spelling of the file name, and verify that the file location is correct.) I believe the code I created looks for the most recently updated and then looks for a file name exactly as the folder and the time/date identified as most recent. There is no file in the folder that will be named as above (they are actually all named something similar to 'PO_report_490_20161120001201-1145.csv').

My code:

Sub SearchFolderforNewBIReport()


Dim fso As Object
Dim folder As Object
Dim wb As Workbook
Dim objFile As File
Dim dteFile As Date

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With


'set up fso objects
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("C:\Users\nilsjohanekman\Desktop\PO Macro\PO Business Intelligence Report")

'loop through each file and get date last modified. If largest date then...
dteFile = DateSerial(1900, 1, 1)
For Each objFile In folder.Files
If objFile.DateLastModified > dteFile Then
Set wb = Workbooks.Open(folder.Path & "" & objFile.DateLastModified).Copy
Workbooks("POManagement.xlsm").Sheets(2).Range ("A1")
wb.Close SaveChanges:=True
End If
Next

Set fso = Nothing
Set folder = Nothing


End Sub

Any advice?

Regards,
Nilsjohanekman
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
1. Select newest file created or modified?
2. Copy all sheets or just one? Obviously, a CSV would just be one sheet.
3. Search in subfolders too or just parent folder.
 
Upvote 0
Hey Gribbin,

Just thought I'd let you know, I figure this one out. And by figuring it out I mean that it works because I have no idea what I'm doing with VBA. jaja

Code

Sub RetrieveData

'Search Folder for most recent CARLA Data
Dim fso, fol, fil
Dim wkbSource As Workbook, wkbData As Workbook
Dim fileData As Date
Dim fileName As String, strExtension As String


Set wkbSource = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder("C:\Users\nilsjohanekman\Desktop\PO Macro\PO CARLA Business Intelligence Report")


fileData = DateSerial(1900, 1, 1)


For Each fil In fol.Files


strExtension = fso.GetExtensionName(fil.Path)
If Left$(strExtension, 3) = "csv" Then


If (fil.DateLastModified > fileData) Then
fileData = fil.DateLastModified
fileName = fil.Path
End If


End If


Next fil


Set wkbData = Workbooks.Open(fileName, , True)

'Retrieve this most recent data and input into Spreadsheet
wkbData.Sheets(1).Cells.Copy
wkbSource.Sheets(2).Range("A1").PasteSpecial Paste:=xlValues


Application.CutCopyMode = False


wkbData.Close


Set fso = Nothing
Set fol = Nothing
Set flc = Nothing
Set wkbData = Nothing

End Sub

**** Note that these are csv files in my case. That condition is noted in "strExtension = fso.GetExtensionName(fil.Path)/ If Left$(strExtension, 3) = "csv" Then".

Regards,
Nilsjohanekman
 
Upvote 0
Nils, when you post code, please do so between code tags. That makes it easier to maintain your structure for others and easier to see what is going on. Type the tags by (code)(/code) but replace ()'s with []'s or click the # icon on the toolbar.

Since I worked this up anyway, here it is. Since we can not use Application.FileSearch since 2007, fso as you used Nils or a Dir() loop will work for iterating just one folder. If we need subfolder loops then a recursive fso loop or a shell routine as I used will suffice. The advantage to my method is that the first file will be the last modified since I sorted it that way.

In a Module, here is my usual shell batching routine.
Code:
'Set extraSwitches, e.g. "/ad", to search folders only.
'MyDir should end in a "\" character unless searching by wildcards, e.g. "x:\test\t*
'Command line switches for the shell's Dir, http://ss64.com/nt/dir.html
Function aFFs(myDir As String, Optional extraSwitches = "", _
  Optional tfSubFolders As Boolean = False) As Variant
  
  Dim s As String, a() As String, v As Variant
  Dim b() As Variant, i As Long
  
  If tfSubFolders Then
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b /s " & extraSwitches).StdOut.ReadAll
    Else
    s = CreateObject("Wscript.Shell").Exec("cmd /c dir " & _
      """" & myDir & """" & " /b " & extraSwitches).StdOut.ReadAll
  End If
  
  a() = Split(s, vbCrLf)
  If UBound(a) = -1 Then
    MsgBox myDir & " not found.", vbCritical, "Macro Ending"
    Exit Function
  End If
  ReDim Preserve a(0 To UBound(a) - 1) As String 'Trim trailing vblfcr
  
  For i = 0 To UBound(a)
    If Not tfSubFolders Then
      s = Left$(myDir, InStrRev(myDir, "\"))
      'add the folder name
      a(i) = s & a(i)
    End If
  Next i
  aFFs = sA1dtovA1d(a)
End Function

Function sA1dtovA1d(strArray() As String) As Variant
  Dim varArray() As Variant, i As Long
  ReDim varArray(LBound(strArray) To UBound(strArray))
  For i = LBound(strArray) To UBound(strArray)
    varArray(i) = CVar(strArray(i))
  Next i
  sA1dtovA1d = varArray()
End Function

I also added an option to skip a file which would usually be the macro's workbook. I also added a feature in LastModifiedExcelFile() to only return the most resent "Microsoft Excel" file type.

In the same Module or another, paste this and modify Main() to suit.
Code:
Sub Main()
  Dim fn As String, wb As Workbook
  'fn = LastModifiedExcelFile(ThisWorkbook.Path & "\", ThisWorkbook.FullName)
  fn = LastModifiedExcelFile(ThisWorkbook.Path & "\*.csv", ThisWorkbook.FullName)

  On Error Resume Next
  Set wb = Workbooks.Open(fn, , True)
  If wb Is Nothing Then Exit Sub
  wb.Worksheets(1).Move after:=ThisWorkbook.Worksheets(Worksheets.Count)
  wb.Close False
End Sub

'inPath must have trailing backslash if only folder is sent.
Function LastModifiedExcelFile(inPath As String, _
  Optional skipFile As String = "", _
  Optional tfSubfolder As Boolean = False) As String
  
  Dim f() As Variant, i As Long, s As String
  Dim fs As String
  'Dim fso As FileSystemObject
  'Set fso = New FileSystemObject
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  f() = aFFs(inPath, "/o-d /a-d")
  s = ""
  For i = 0 To UBound(f)
    fs = Left(fso.GetFile(f(i)).Type, 15) = "Microsoft Excel"
    If fs <> True Then GoTo NextI
    If LCase(skipFile) = LCase(Replace(Replace(f(i), "~", ""), _
      "$", "")) Then GoTo NextI
    s = f(i)
    Exit For
NextI:
  Next i
  
  Set fso = Nothing
  LastModifiedExcelFile = s
End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top