Unzip latest file from Source path to destination path

[DSSD]

Hi,

I am trying to unzip latest file and copy contents in it and paste in different Path/folder.

When I am using this code I am able to open the zip file which i mentioned and was able to paste it in destinationPath

ub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)

Dim ShellApp As Object

'Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).Items, 16

End Sub
Sub OpnZip()
Call UnzipAFile("SourcePath\2024-01-24_ChargeErrorWorklistAll.zip", "DestinationPath\")
End Sub


Now I need a code to look for latest zip file in sourcePath, open it and copy the file to DestinationPath. Can anyone help me here?

 

[Domenic]

Try the following code...

Option Explicit

Sub OpnZip()

    Dim errorMessage As String
    errorMessage = ""

    If Not unzipLatestZippedFolderItem("c:\users\domenic\desktop\sample.zip", "c:\users\domenic\desktop", errorMessage) Then
        MsgBox errorMessage, vbCritical
        Exit Sub
    End If
    
    MsgBox "Completed", vbInformation
    
End Sub

Public Function unzipLatestZippedFolderItem(ByVal zipFolderName As Variant, ByVal unzipToPath As Variant, ByRef errorMessage As String) As Boolean

    On Error GoTo errorHandler

    Dim sh As Object 'Shell32.Shell
    Set sh = CreateObject("Shell.Application") 'New Shell32.Shell
    
    Dim zipFolder As Object 'Shell32.Folder3
    Set zipFolder = sh.Namespace(zipFolderName)
    
    Dim currentFolderItem As Object 'Shell32.FolderItem
    Dim latestFolderItem As Object 'Shell32.FolderItem
    Dim currentModifiedDate As Date
    Dim latestModifiedDate As Date
    
    latestModifiedDate = 0
    For Each currentFolderItem In zipFolder.Items
        currentModifiedDate = currentFolderItem.ModifyDate
        If currentModifiedDate > latestModifiedDate Then
            latestModifiedDate = currentModifiedDate
            Set latestFolderItem = currentFolderItem
        End If
    Next currentFolderItem
    
    sh.Namespace(unzipToPath).CopyHere latestFolderItem.Path
    
    unzipLatestZippedFolderItem = True
    
exitHandler:
    Set sh = Nothing
    Set zipFolder = Nothing
    Set currentFolderItem = Nothing
    Set latestFolderItem = Nothing
    
    Exit Function
    
errorHandler:
    errorMessage = "Error " & Err.Number & ": " & Err.Description
    unzipLatestZippedFolderItem = False
    Resume exitHandler
    
End Function

Hope this helps!

 

[DSSD]

Thank you Domenic. The code is working partially and with this code I was able to copy the latest Zip file from my source path to destination. However, I want a code that opens the latest Zip file in the Source Path, copy the file init and paste it in Destination path. I have attached few screenshots if it helps. Thanks a ton.

 

[Domenic]

Oh I see, it looks like I misunderstood.

When you say that you want the latest zip file, I assume that you want the latest based on the date found at the beginning of the filename. If in fact you want to base it on the file's modified date, replace...

        currentDate = CDate(Left$(currentZipFile, 10))

with

        currentDate = FileDateTime(sourcePath & currentZipFile)

Here's the code...

Sub OpnZip()

    Dim latestZipFile As String
  
    latestZipFile = getLatestZipFile("SourcePath\")
  
    If Len(latestZipFile) = 0 Then
        MsgBox "No Zip files found!", vbExclamation
        Exit Sub
    End If
  
    UnzipAFile "SourcePath\" & latestZipFile, "DestinationPath\"
  
End Sub

Function getLatestZipFile(ByVal sourcePath As String) As String

    Dim currentZipFile As String
    Dim latestZipFile As String
    Dim currentDate As Date
    Dim latestDate As Date
  
    If Right$(sourcePath, 1) <> "\" Then
        sourcePath = sourcePath & "\"
    End If
  
    currentZipFile = Dir(sourcePath & "????-??-??_ChargeErrorWorklistAll.zip", vbNormal)
  
    If Len(currentZipFile) = 0 Then
        getLatestZipFile = vbNullString
        Exit Function
    End If
  
    latestDate = 0
    Do While Len(currentZipFile) > 0
        currentDate = CDate(Left$(currentZipFile, 10))
        If currentDate > latestDate Then
            latestDate = currentDate
            latestZipFile = currentZipFile
        End If
        currentZipFile = Dir
    Loop
  
    getLatestZipFile = latestZipFile
  
End Function

Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)

    Dim sh As Object
    Set sh = CreateObject("Shell.Application")
  
    sh.Namespace(unzipToPath).CopyHere sh.Namespace(zippedFileFullName).items, 16
  
End Sub

Hope this helps!

 

[DSSD]

Thank you Very much Domenic. It's working just good as I wanted. Once Again Thank you very much.

 

[DSSD]

With code you have provided I have tried to modify and i trying to do same job but in sharepoints and I am not able to achieve it. below is the code i am trying
Sub OpnZip()



Dim latestZipFile As String

' Update the SharePoint site URL
latestZipFile = getLatestZipFile("https://mine.sharepoint.com/sites/My-FinSys/eCFProd/CEWL/")



If Len(latestZipFile) = 0 Then
MsgBox "No Zip files found!", vbExclamation
Exit Sub
End If

On Error Resume Next
' Update the SharePoint site URL for source and destination
DownloadFileFromSharePoint "https:// mine.sharepoint.com/sites/My -FinSys/eCFProd/CEWL/" & latestZipFile, "C:\Temp\" & latestZipFile
If Err.Number <> 0 Then
MsgBox "Error: " & Err.Description, vbCritical
Err.Clear
Exit Sub
End If
On Error GoTo 0



' Now, you can use your existing code to unzip the downloaded file
UnzipAFile "C:\Temp\" & latestZipFile, "\\ mine.sharepoint.com/\sites\GRP-SOP-AppMgmtOps\Shared Documents\General\01 Knowledge Acquisition\Enterprise\RCM\CEWL and Suspense Report\"



' Optionally, clean up the downloaded file from the local directory
Kill "C:\Temp\" & latestZipFile



MsgBox "Operation completed successfully!", vbInformation



End Sub



Function getLatestZipFile(ByVal sourcePath As String) As String
Dim xmlHTTP As Object
Dim responseText As String
Dim latestZipFile As String
Dim currentDate As Date
Dim startIndex As Long
Dim endIndex As Long
Dim fileName As String



' Send HTTP request to get file names from SharePoint
Set xmlHTTP = CreateObject("MSXML2.ServerXMLHTTP")
xmlHTTP.Open "GET", sourcePath & "?\$top=1000", False
xmlHTTP.send



If xmlHTTP.Status = 200 Then
responseText = xmlHTTP.responseText



' Extract dates directly from filenames
startIndex = InStr(responseText, "_ChargeErrorWorklistAll.zip")
While startIndex > 0
' Extract the full filename
endIndex = InStr(startIndex, responseText, """")
fileName = Mid(responseText, startIndex, endIndex - startIndex + 5)



' Extract date from the filename
currentDate = CDate(Mid(fileName, 1, 10))



Debug.Print "Found file: " & fileName & " with date: " & currentDate



' Check if it's the latest file
If currentDate > latestDate Then
latestDate = currentDate
latestZipFile = fileName
End If



' Move to the next occurrence
startIndex = InStr(startIndex + 1, responseText, "_ChargeErrorWorklistAll.zip")
Wend



Debug.Print "Latest file found: " & latestZipFile
Else
Debug.Print "Failed to get file list from SharePoint. HTTP Status: " & xmlHTTP.Status
Err.Raise vbObjectError + 1, "getLatestZipFile", "Failed to get file list from SharePoint."
End If



getLatestZipFile = latestZipFile
End Function





Sub DownloadFileFromSharePoint(sourceURL As String, destinationPath As String)
Dim xmlHTTP As Object
Set xmlHTTP = CreateObject("MSXML2.ServerXMLHTTP")



xmlHTTP.Open "GET", sourceURL, False
xmlHTTP.send



If xmlHTTP.Status = 200 Then
Dim oStream As Object
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write xmlHTTP.responseBody
oStream.SaveToFile destinationPath, 2
oStream.Close
Else
Err.Raise vbObjectError + 1, "DownloadFileFromSharePoint", "Failed to download file from SharePoint."
End If
End Sub



Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)
Dim sh As Object
Set sh = CreateObject("Shell.Application")

sh.Namespace(unzipToPath).CopyHere sh.Namespace(zippedFileFullName).Items, 16
End Sub


Output I am getting is no Zip file found. Can you please help me here?