VBA code to download zip and extract csv file from it and save with specified name

[playtime007]

I am having a simple application in excel to download all zip urls in column "C" column "C" has urls and column "Q" has names Every url has 1 zip file and every zip has 1 csv in it. What I want to do is to 1. unzip the CSV files and save them with names as mentioned in column "Q" 2. Kill all the zip 3. CSV file must be overwritten as I will be doing this task on daily basis so when the next day or next time I perform the task it must overwrite the previous file

Sub Download_All()
Dim lr As Long
Dim fileurl As String, filename As String
Dim r As Long
lr = Sheets("Downloads").Range("C" & Rows.Count).End(xlUp).Row
For r = 5 To lr
    fileurl = Sheets("Downloads").Range("C" & r).Value


    If InStr(1, fileurl, ".zip") <> 0 Then
        filepath = "C:\MyDownloads\"

    End If
            Dim Obj1 As Object
    Set Obj1 = CreateObject("Microsoft.XMLHTTP")
    Obj1.Open "GET", fileurl, False
    Obj1.send
    If Obj1.Status = 200 Then
        Set Obj2 = CreateObject("ADODB.Stream")
        Obj2.Open
        Obj2.Type = 1
        Obj2.Write Obj1.responseBody
        Obj2.SaveToFile (filepath & getfilename(fileurl)), 2 ' 1 = no overwrite, 2 = overwrite

        Obj2.Close
    End If
    Next r
End Sub

Function getfilename(filepath As String)
    Dim v_string() As String
    v_string = Split(filepath, "/")
    getfilename = v_string(UBound(v_string))
End Function

 

[playtime007]

Yes, As before

 

[Yongle]

In that case, replace the Function with this and try again

Private Function UnzipFileRename(zipFullName As Variant, unzipPath As Variant, newName As String) As String
    Dim ShellApp As Object, oldfullName As String, newfullName As String, n As Variant, a As Integer, d As String
    Set ShellApp = CreateObject("Shell.Application")
'get file name
    For Each n In ShellApp.Namespace(zipFullName).Items
        a = a + 1
        oldfullName = unzipPath & n.Name
        newfullName = unzipPath & newName
        If a = 1 Then Exit For
    Next n
'delete previous version to avoid any issues
    DeleteFile oldfullName
    DeleteFile newfullName
'unzip the file
    ShellApp.Namespace(unzipPath).CopyHere ShellApp.Namespace(zipFullName).Items
'rename the file
    Name oldfullName As newfullName
'delete zip file
    DeleteFile CStr(zipFullName)
    If Dir(newfullName) <> "" Then d = " downloaded" Else d = " download failed"
    UnzipFileRename = d
End Function

 

[playtime007]

Still as it was before.
Showing downloaded msg only

 

[Yongle]

See what happens when you insert these message boxes
Do the 2 new message boxes give you the correct result ?

    If Obj1.Status = 200 Then
        Set Obj2 = CreateObject("ADODB.Stream")
        Obj2.Open
        Obj2.Type = 1
        Obj2.Write Obj1.responseBody
        Obj2.SaveToFile (filepath & getfilename(fileurl)), 2 ' 1 = no overwrite, 2 = overwrite

        Obj2.Close
        MsgBox fileurl & " Downloaded"
    Else
        MsgBox fileurl & " Download failed"
    End If

 

[playtime007]

yes, Its providing information about all downloads including failed one.
But, its popping up MsgBox 3 times for all 3 files.
I tried combining them using y as string, z as string BUT I FAILED TO DO AS WHEN COMBINED IT GIVES ONLY 1 FAILED VALUE NOT ALL


<< unavailable video removed >>

 

[Yongle]

You need the string to build so
BAD
y= fileurl & " Downloaded"
GOOD
y = y & vbcr & fileurl & " Downloaded"

Same for Z

See if that gives correct strings

 

[playtime007]

EVERYTHING IS PERFECT NOW

Also, deleting this from kill code has no Negative effect

'If Dir(newfullName) <> "" Then d = " DOWNLOADED " Else d = " download failed "
'UnzipFileRename = d

Should I delete or deleting might create trouble in future

 

[Yongle]

EVERYTHING IS PERFECT NOW

Good

The Function to get the string is no longer necessary
So it would probably be better if you replace the function with the original sub)
To do that
- Read post 2 again and do what I told you to do in that post
- add the code to generate string Y & z (as per post#16)

 

[Yongle]

Also, deleting this from kill code has no Negative effect

'If Dir(newfullName) <> "" Then d = " DOWNLOADED " Else d = " download failed "
'UnzipFileRename = d

Should I delete or deleting might create trouble in future

See previous post for suggested solution

But if you prefer then you could simply delete that line and the function will always return an empty string
- it should not cause you a problem

 

[playtime007]

Hi Mate,
Can I dare to Offer you some $$
pls provide your paypal