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

playtime007

New Member
Joined
Feb 3, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. Windows
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







VBA Code:
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
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
In that case, replace the Function with this and try again

VBA Code:
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
See what happens when you insert these message boxes
Do the 2 new message boxes give you the correct result ?

Rich (BB code):
    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

New Member
Joined
Feb 3, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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


 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Feb 3, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Feb 3, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. Windows
Hi Mate,
Can I dare to Offer you some $:)$
pls provide your paypal
 

Forum statistics

Threads
1,148,337
Messages
5,746,170
Members
423,998
Latest member
eakenila

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
Top