• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro to check latest file in folder & move to another folder

Nitesh Khot

Member
Hi Experts,

I am looking a vba code to check latest excel file in folder and copy data into macro file and then move file into another folder...

How to do this using vba code ???

Thanks in advance..
nitesh
 
Hello Nitesh
Assuming that you have two folders "Test" & "Final" in the same path of the workbook that contain the following code
The folder Test would contain some files and you need to deal with the latest file, then open it then copy used range to thisworkbook and finally move the file to another folder named "Final"

Try the following code
Code:
Sub Open_Latest_File_Copy_Move()
    Dim strPath    As String
    Dim strDest    As String
    Dim myFile      As String
    Dim LatestFile  As String
    Dim LatestDate  As Date
    Dim Lmd        As Date
    Dim Wb          As Workbook
    Dim fso        As Object

    'The Folder 'Test' Contains The File To Be Checked
    strPath = ThisWorkbook.Path & "\Test\"

    'The Folder 'Final' Where The File Will Be Moved
    strDest = ThisWorkbook.Path & "\Final\"
  
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    myFile = Dir(strPath & "*.xls*", vbNormal)
  
    If Len(myFile) = 0 Then
        MsgBox "No Files Were Found...", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Do While Len(myFile) > 0
            Lmd = FileDateTime(strPath & myFile)
  
            If Lmd > LatestDate Then
                LatestFile = myFile
                LatestDate = Lmd
            End If
  
            myFile = Dir
        Loop
  
        Set Wb = Workbooks.Open(strPath & LatestFile)
  
        Wb.Sheets("Sheet1").UsedRange.Copy ThisWorkbook.Sheets("Sheet1").Range("A1")
        Wb.Close SaveChanges:=False
  
        strPath = strPath & LatestFile
        Call fso.CopyFile(strPath, strDest)
        Kill strPath
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Set Wb = Nothing
    MsgBox "Done...", 64
End Sub
 
Back
Top