VBA to add vba

[sassriverrat]

So I have a wonderful piece of code that someone helped me put together. It downloads a file from a website (just a pdf from a cell-specified URL) and then time stamps it (so you can quickly download again for updates).

It references cell A1 for the URL... and I have 5 pieces that download currently (so 5 copies of this macro)....

Is it possible to have a piece of code that dynamically can add/delete vba. The idea being that if the user wants to add a new download, they can hit a button that would add the necessary code in place to copy the previous code but adding a new cell (so A6 now instead of A5 in the previous macro)? Hopefully this makes sense

 

[sassriverrat]

Didn't you write that piece for me?

 

[Norie]

The last code I posted didn't have that line in it but it did have a minor error, try this.

Option Explicit

Sub Download()
Dim URL As String
Dim tstamp As String
Dim Folder0 As String
Dim Folder1 As String
Dim Namer As String
Dim Date0 As String
Dim Date1 As String
Dim LocalFilePath As String
Dim TempFolderOLD As String
Dim TempFileNEW As String
Dim DownloadStatus As Long
Dim LastRow As Long

Dim rw As Long

    ' find last row of data in column B on 'Background'
    LastRow = Sheets("Background").Range("B" & Rows.Count).End(xlUp).Row

    ' loop through rows on 'Background'
    For rw = 4 To LastRow
    
        With Sheets("Background")
            Namer = .Range("B" & rw)    'Pub name
            URL = .Range("I" & rw)   'URL to download
            Date0 = .Range("E" & rw)    'Week #
            Date1 = .Range("C" & rw)    'Year #
        End With
        
        With Sheets("Setup")
            Folder0 = .Range("B5")    'temp file
            Folder1 = .Range("B7")    'permanent file
        End With
        
        TempFolderOLD = Environ("Userprofile") & "\" & Folder0
        tstamp = Format(Now, "mm-dd-yyyy")
        TempFileNEW = TempFolderOLD & tstamp & "\" & Namer & ".pdf"
        LocalFilePath = Environ("Userprofile") & "\" & Folder1 & "\" & Namer & ".pdf"

        'If these criteria are met, let's begin the download tree
        If Date1 <> Sheets("Background").Range("G2") And Date0 <> Sheets("Background").Range("I2") Then

            'Let's assign everything to the temp folder
            'Begin by clearing any possible undeleted/corrupted files from my "temp" folder
            If Len(Dir(TempFolderOLD)) <> "" Then Kill (TempFolderOLD)
            'Make a new temp folder
            If Len(Dir(TempFolderOLD)) = "" Then MkDir (TempFolderOLD)
            'Attempt download to the temp folder
            DownloadStatus = URLDownloadToFile(0, URL, TempFileNEW, 0, 0)
            'Check for proper download
            If DownloadStatus = 0 Then
                'Delete the old files
                Kill (LocalFilePath)
                'Save temp files to replace old files
                TempFileNEW.SaveAs Filename:=LocalFilePath, FileFormat:=xlTypePDF
                'Now delete temp files
                Kill (TempFileNEW)
                'Now update excel sheet to show download passed
                MsgBox "File Downloaded. Check in this path: " & LocalFilePath
                
                With Sheets("Background")
                    .Range("F" & rw) = tstamp
                    .Range("G" & rw) = "SAT"
                    .Range("C" & rw) = Format(Now, "ww", vbWednesday)
                    .Range("E" & rw) = Format(Now, "yy")
                End With
                
                'If download failed, update excel to show- old files should NOT have been deleted yet but the temp file should be deleted
            Else:
                MsgBox "Download File Process Failed"
                Sheets("Background").Range("G" & rw) = "FAIL"
                Kill (TempFolderOLD)
            End If
            'If the original criteria were met and the download was not necessary, say so
        Else

            MsgBox "The most up to date pub has been downloaded"
        End If
        
    Next rw

End Sub

 

[sassriverrat]

So I got it tweaked to this and it's been working like a champ. However, I'd still like to keep this (for a one button does all feature) and then have a revised version of the code so that I can have a line by line series of download buttons. You asked why- basically considering how slow the internet is- they downloads tend to take 3-6 minutes each (with over 15 downloads). So the idea being now being, if the user wants to quickly update one of the downloads to view it and then run the rest of them later, they can do that. Make sense?

Sub Downloadx()Dim URL As String
Dim tstamp As String
Dim Folder0 As String
Dim Folder1 As String
Dim Folder2 As String
Dim folder3 As String
Dim Namer As String
Dim Date0 As String
Dim Date1 As String
Dim LocalFilePath As String
Dim TempFolderOLD As String
Dim OldFinalName As String
Dim TempFileNEW As String
Dim DownloadStatus As Long
Dim LastRow As Long
Dim Finalname As String
Dim btn As Shape
Dim MyFSO As FileSystemObject
Set MyFSO = New Scripting.FileSystemObject


Dim rw As Long


    ' find last row of data in column B on 'Background'
    LastRow = Sheets("Background").Range("B" & Rows.Count).End(xlUp).Row


    ' loop through rows on 'Background'
    'For rw = 4 To LastRow
    For rw = 4 To Sheets("Background").Range("B" & Rows.Count).End(xlUp).Row
            
            With Sheets("Background")
            Namer = .Range("B" & rw)    'Pub name
            URL = .Range("I" & rw)      'URL to download
            Date0 = .Range("E" & rw)    'Week #
            Date1 = .Range("C" & rw)    'Year #
        End With
        
        With Sheets("Setup")
            Folder0 = .Range("B5")    'temp folder (desktop)
            Folder1 = .Range("B7")    'permanent folder (desktop)
            Folder2 = .Range("C7")    'permanent folder
            folder3 = .Range("C5")    'temp Folder
        End With
        
        TempFolderOLD = Environ("Userprofile") & "\" & Folder0 & "\" & folder3 & "\"
        tstamp = Format(Now, "mm-dd-yyyy")
        TempFileNEW = TempFolderOLD & tstamp & Namer & ".pdf"
        LocalFilePath = Environ("Userprofile") & "\" & Folder1 & "\" & Folder2 & "\"
        Finalname = Namer & ".pdf"
        OldFinalName = LocalFilePath & Finalname
        
        'If these criteria are met, let's begin the download tree
        If Date1 <> Sheets("Background").Range("G2") And Date0 <> Sheets("Background").Range("I2") Then


            'Let's assign everything to the temp folder
            'Begin by clearing any possible undeleted/corrupted files from my "temp" folder
            If MyFSO.FileExists(TempFolderOLD) Then Kill (TempFolderOLD)
            'Make a new temp folder
            If (Dir(TempFolderOLD, vbDirectory)) = "" Then MkDir (TempFolderOLD)
            'Attempt download to the temp folder
            DownloadStatus = URLDownloadToFile(0, URL, TempFileNEW, 0, 0)
            'Check for proper download
            If DownloadStatus = 0 Then
                'Delete the old files
                If MyFSO.FileExists(OldFinalName) Then
                    Kill (OldFinalName)
                    MkDir (LocalFilePath)
                End If
                'Save temp files to replace old files
                'TempFileNEW.SaveAs Filename:=LocalFilePath, FileFormat:=xlTypePDF
                MyFSO.CopyFile Source:=TempFileNEW, Destination:=LocalFilePath
                'Now delete temp files
                Kill (TempFolderOLD)
                'Now update excel sheet to show download passed
                MsgBox "File Downloaded. Check in this path: " & LocalFilePath
                
                With Sheets("Background")
                    .Range("F" & rw) = tstamp
                    .Range("G" & rw) = "SAT"
                    .Range("C" & rw) = Format(Now, "ww", vbWednesday)
                    .Range("E" & rw) = Format(Now, "yy")
                End With
                
                'If download failed, update excel to show- old files should NOT have been deleted yet but the temp file should be deleted
            Else:
                MsgBox "Download File Process Failed"
                Sheets("Background").Range("G" & rw) = "FAIL"
                If MyFSO.FileExists(TempFolderOLD) Then
                Kill (TempFolderOLD)
                End If
            End If
            'If the original criteria were met and the download was not necessary, say so
        Else


            MsgBox "The most up to date pub has been downloaded"
        End If
        
    Next rw


End Sub

 

[sassriverrat]

@Norie

So the code has to evolved to this (and was working) last week. Now that the date piece (i.e. the dates don't match so it SHOULD go through the download process) is different, it got stuck at the Kill TempFolderOLD line- saying the folder couldn't be found despite seeing the folder on the desktop. Further, for the first few minutes I kept running the code and it was saying the dates were equal even though I visually see they are different.

Sub Downloadx()Dim URL As String
Dim tstamp As String
Dim Folder0 As String
Dim Folder1 As String
Dim Folder2 As String
Dim folder3 As String
Dim Namer As String
Dim Date0 As String
Dim Date1 As String
Dim Date2 As String
Dim Date3 As String
Dim Divider As String
Dim LocalFilePath As String
Dim TempFolderOLD As String
Dim OldFinalName As String
Dim TempFileNEW As String
Dim DownloadStatus As Long
Dim LastRow As Long
Dim Finalname As String
Dim btn As Shape
Dim MyFSO As FileSystemObject
Set MyFSO = New Scripting.FileSystemObject


Dim rw As Long


    ' find last row of data in column B on 'Background'
    LastRow = Sheets("Background").Range("B" & Rows.Count).End(xlUp).Row


    ' loop through rows on 'Background'
    'For rw = 4 To LastRow
    For rw = 4 To Sheets("Background").Range("B" & Rows.Count).End(xlUp).Row
            
            With Sheets("Background")
            Namer = .Range("B" & rw)    'Pub name
            URL = .Range("I" & rw)      'URL to download
            Date0 = .Range("C" & rw)    'Week #
            Date1 = .Range("E" & rw)    'Year #
            Divider = .Range("D" & rw)  '\
            Date2 = .Range("G2")        'base week
            Date3 = .Range("I3")        'base year
        End With
        
        With Sheets("Setup")
            Folder0 = .Range("B5")    'temp folder (desktop)
            Folder1 = .Range("B7")    'permanent folder (desktop)
            Folder2 = .Range("C7")    'permanent folder
            folder3 = .Range("C5")    'temp Folder
        End With
        
        TempFolderOLD = Environ("Userprofile") & "\" & Folder0 & "\" & folder3 & "\"
        tstamp = Format(Now, "mm-dd-yyyy")
        TempFileNEW = TempFolderOLD & tstamp & Namer & ".pdf"
        LocalFilePath = Environ("Userprofile") & "\" & Folder1 & "\" & Folder2 & "\"
        Finalname = Namer & ".pdf"
        OldFinalName = LocalFilePath & Finalname
        
        
        'If these criteria are met, let's begin the download tree
        If Date0 <> Date2 And Date1 <> Date3 Then
    
            'Let's assign everything to the temp folder
            'Begin by clearing any possible undeleted/corrupted files from my "temp" folder
            If MyFSO.FileExists(TempFolderOLD) Then Kill (TempFolderOLD)
            'Make a new temp folder
            If (Dir(TempFolderOLD, vbDirectory)) = "" Then MkDir (TempFolderOLD)
            'Attempt download to the temp folder
            DownloadStatus = URLDownloadToFile(0, URL, TempFileNEW, 0, 0)
            'Check for proper download
            If DownloadStatus = 0 Then
                'Delete the old files
                If MyFSO.FileExists(OldFinalName) Then
                    Kill (OldFinalName)
                    MkDir (LocalFilePath)
                End If
                'Save temp files to replace old files
                'TempFileNEW.SaveAs Filename:=LocalFilePath, FileFormat:=xlTypePDF
                MyFSO.CopyFile Source:=TempFileNEW, Destination:=LocalFilePath
                'Now delete temp files
                Kill (TempFolderOLD)
                'Now update excel sheet to show download passed
                MsgBox "File Downloaded. Check in this path: " & LocalFilePath
                
                With Sheets("Background")
                    .Range("F" & rw) = tstamp
                    .Range("G" & rw) = "SAT"
                    .Range("C" & rw) = Format(Now, "ww", vbWednesday)
                    .Range("E" & rw) = Format(Now, "yy")
                    'date formating
                    .Range("C" & rw).HorizontalAlignment = xlRight
                    .Range("D" & rw).HorizontalAlignment = xlGeneral
                    .Range("E" & rw).HorizontalAlignment = xlLeft
                End With
                
                'If download failed, update excel to show- old files should NOT have been deleted yet but the temp file should be deleted
            Else:
                MsgBox "Download File Process Failed"
                Sheets("Background").Range("G" & rw) = "FAIL"
                If MyFSO.FileExists(TempFolderOLD) Then
                Kill (TempFolderOLD)
                End If
            End If
            'If the original criteria were met and the download was not necessary, say so
        Else


            MsgBox "The most up to date pub has been downloaded"
        End If
        
    Next rw


End Sub