File downloader VBA to VBS

savindrasingh

Board Regular
Joined
Sep 10, 2009
Messages
183
Hello Experts,

I have below code to download some files from given URLs using VBA. Is there a way using which I can use this function in VB Script? Currently it is not allowing me to use these functions as is:

Code:
Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
 
Private Sub Downloader()
    Dim FS As Object
    Dim ThisWeekURL, LastWeekURL As String
    LastWeekFile = "ESM-LOB-WEEKLY-REM-MON-DOM-GIDB-W-" & Format(Date - 7 - (Weekday(Date - 7) - 1), "yyyy-mm-dd")
    ThisWeekFile = "ESM-LOB-WEEKLY-REM-MON-DOM-GIDB-W-" & Format(Date - (Weekday(Date) - 1), "yyyy-mm-dd")
    OldAlertsFile = "Alerts_" & Format(Date - 7 - (Weekday(Date - 7) - 3), "mmddyy") & ".xlsx"
    NewAlertsFile = "Alerts_" & Format(Date - (Weekday(Date) - 3), "mmddyy") & ".xlsx"
    
    ThisWeekURL = "[URL]http://discovery.nbgfn.com/Discovery/livelink/66475310/[/URL]" & ThisWeekFile & ".zip?func=doc.Fetch&nodeid=66475310&viewType=1"
    LastWeekURL = "[URL]http://discovery.nbgfn.com/Discovery/livelink/66412562/[/URL]" & LastWeekFile & ".zip?func=doc.Fetch&nodeid=66412562&viewType=1"
    AlertsURL = "[URL]http://sharepoint.bankofamerica.com/sites/RiskandCompliance/compliance/Wintel%20ESM%20Remediation/Alerts/[/URL]" & OldAlertsFile
    
    Location = Environ("programfiles") & Application.PathSeparator & "ESM Reporting" & Application.PathSeparator & "Week-" & WorksheetFunction.WeekNum(Date, 1) & Application.PathSeparator
'Check if required week folder exists, if not then create it
    On Error Resume Next
    ReportDir = GetAttr(Location)
    If Err <> 0 Then
        RootDir = GetAttr(Environ("programfiles") & Application.PathSeparator & "ESM Reporting")
        If Err <> 0 Then
            MkDir (Environ("programfiles") & Application.PathSeparator & "ESM Reporting" & Application.PathSeparator)
            ChDir (Environ("programfiles") & Application.PathSeparator & "ESM Reporting" & Application.PathSeparator)
        Else
        End If
        MkDir (Location)
        ChDir (Location)
    End If
'End checking for folder existance
    Application.DisplayAlerts = False
    On Error Resume Next
    Set fileChecker = CreateObject("Scripting.FileSystemObject")
    DownloadFile ThisWeekURL, Location & ThisWeekFile & ".zip"
    Do While Not fileChecker.FileExists(Location & ThisWeekFile & ".zip"): Loop
    
    On Error Resume Next
    DownloadFile LastWeekURL, Location & LastWeekFile & ".zip"
    Do While Not fileChecker.FileExists(Location & LastWeekFile & ".zip"): Loop
    
    DownloadFile AlertsURL, Location & NewAlertsFile
    
    Set Winrar = CreateObject("Wscript.Shell")
    UnZipCmd1 = "Winrar e -pesm4wsu -o+ """ & Location & ThisWeekFile & ".zip""" & " """ & Location & """"
    UnzipCmd2 = "Winrar e -pesm4wsu -o+ """ & Location & LastWeekFile & ".zip""" & " """ & Location & """"
    
    Winrar.Run UnZipCmd1
    Winrar.Run UnzipCmd2
        
    Workbooks.Open Filename:=Location & ThisWeekFile & ".xls"
    Workbooks(ThisWeekFile & ".xls").SaveAs Filename:=Location & ThisWeekFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Workbooks(ThisWeekFile & ".xlsx").Close
    
    Workbooks.Open Filename:=Location & LastWeekFile & ".xls"
    Workbooks(LastWeekFile & ".xls").SaveAs Filename:=Location & LastWeekFile & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Workbooks(LastWeekFile & ".xlsx").Close
    
'Take backup copy of all the files downloaded
    MkDir (Location & "Backup")
    
    Set FS = CreateObject("Scripting.FileSystemObject")
    FS.CopyFile Location & ThisWeekFile & ".xlsx", Location & "Backup\"
    FS.CopyFile Location & LastWeekFile & ".xlsx", Location & "Backup\"
    FS.CopyFile Location & NewAlertsFile & ".xlsx", Location & "Backup\"
    
'    CopyFile FilePath:=Location & ThisWeekFile & ".xlsx", DestFolderPath:=Location & "Backup\"
'    CopyFile FilePath:=Location & LastWeekFile & ".xlsx", DestFolderPath:=Location & "Backup\"
'    CopyFile FilePath:=Location & NewAlertsFile & ".xlsx", DestFolderPath:=Location & "Backup\"
    
    If fileChecker.FileExists(Location & ThisWeekFile & ".xlsx") Then Kill Location & ThisWeekFile & ".xls"
    If fileChecker.FileExists(Location & LastWeekFile & ".xlsx") Then Kill Location & LastWeekFile & ".xls"
    
    Application.DisplayAlerts = True
End Sub
 
Public Function DownloadFile(ByVal URL As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

Thanks in advance for any help.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,215,219
Messages
6,123,681
Members
449,116
Latest member
HypnoFant

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