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

 

[James006]

Hello,

You need to use the VBA Extensibility Library ...

Chip Pearson has an excellent explanation : http://www.cpearson.com/Excel/vbe.aspx

Hope this will help

 

[Norie]

Can you post the current code?

 

[sassriverrat]

Sorry for the delay @Norie, I thought this had posted.

Basically I'm currently setting this workbook up so that each of the downloads has a "download" button that runs the below macro and a "view" button that runs a macro to open the download. I currently have 5 downloads (drawing the info and URLs from the 4, 5, 6, 7, and 8 rows (B4, E4, etc). Thanks

Private Sub Download1()Dim URL As String
Dim tstamp As String
Dim Namer As String
Dim Dater As String
Dim Downstatus As String
Dim LocalFilePath As String
Dim DownloadStatus As Long
With Sheets("Background")
    Namer = .Range("B4")
    URL = .Range("F4")
    Downstatus = .Range("E4").Value
    Dater = .Range("E1")
End With
    
    If Dater = Downstatus Then
    tstamp = Format(Now, "dd-mmm-yyyy")
        LocalFilePath = Environ("Userprofile") & "\Documents\" & tstamp & "\" & Namer & ".pdf"
        DownloadStatus = URLDownloadToFile(0, URL, LocalFilePath, 0, 0)
        If DownloadStatus = 0 Then
            MsgBox "File Downloaded. Check in this path: " & LocalFilePath
            Sheets("Background").Range("E4").Value = tstamp
        Else
            MsgBox "Download File Process Failed"
        End If
    Else: MsgBox "The most up to date pub has been downloaded"
    End If
End Sub

 

[Norie]

Are you repeating this code for each button?

 

[sassriverrat]

Are you repeating this code for each button?

So far I have been because I couldn't think of a better way to do it, but I'm open ears. My plan is to have someone download everything every time but running over a VERY slow satellite connection- so if one fails- then I can go back adn download it individually.

 

[sassriverrat]

Ok so to answer your question @Norie, here's a better representation of the code

Private Sub Download13()Dim URL As String
Dim tstamp As String
Dim Namer As String
Dim Date0 As String
Dim Date1 As String
Dim LocalFilePath As String
Dim DownloadStatus As Long
With Sheets("Background")
    Namer = .Range("B4") 'This changes B4 to B5 to B6 etc with each macro
    URL = .Range("I4") 'This changes I4 to I5 to I6 with each macro
    Date1 = .Range("F4") 'This changes F4 to F5 to F6 etc with each macro
End With
    
    If Date1 <> Sheets("Background").Range("G1") Then 'G1 stays the same. G1 could be replaced with TODAY() as that's all the cell is equal to
        tstamp = Format(Now, "mm-dd-yyyy")
        LocalFilePath = Environ("Userprofile") & "\Documents\" & tstamp & Namer & ".pdf"
        DownloadStatus = URLDownloadToFile(0, URL, LocalFilePath, 0, 0)
        If DownloadStatus = 0 Then
            MsgBox "File Downloaded. Check in this path: " & LocalFilePath
            Sheets("Background").Range("F4") = tstamp 'F4 changes to F5 to F6 etc with each macro
            Sheets("Background").Range("G4") = "SAT" 'G4 changes to G5 to G6 etc with each macro
        Else
            MsgBox "Download File Process Failed"
            Sheets("Background").Range("G4") = "FAIL" 'G4 changes to G5 to G6 etc with each macro
        End If
    Else: MsgBox "The most up to date pub has been downloaded"
    End If
End Sub

 

[Norie]

If all you are changing is the row what you are getting the values fro Name, URL, Date1 etc. then you can probably do this without using code to create code.

How are you currently calling the code?

Do you want to run the code for all populated rows?

 

[sassriverrat]

Currently calling each of the codes via buttons. So each row within the activesheet has a button. Each button calls the code for the cells on that row. I'd like to have the ability to call the code for the whole lot of rows as well as individually. The fun also begins as some rows are empty but could, someday, be populated.

 

[Norie]

If each button is on the same row as the data and the buttons are created from the Forms toolbar then we can use Application.Caller to identify the button that has been clicked and from that determine the row.

Something like this, which you would assign to each of the buttons.

Private Sub DownloadX()
Dim URL As String
Dim tstamp As String
Dim Namer As String
Dim Date0 As String
Dim Date1 As String
Dim LocalFilePath As String
Dim DownloadStatus As Long
Dim btn As Shape
Dim rw As Long

    With Sheets("Background")
        
        Set btn = .Shapes(Application.Caller)
        
        ' rw should be the row the button that has been clicked is on.
        rw = btn.TopLeftCell.Row
        
        Namer = .Range("B" & rw) 
        URL = .Range("I" & rw)
        Date1 = .Range("F" & rw) 
    End With
    
    If Date1 <> Sheets("Background").Range("G1") Then 'G1 stays the same. G1 could be replaced with TODAY() as that's all the cell is equal to
        tstamp = Format(Now, "mm-dd-yyyy")
        LocalFilePath = Environ("Userprofile") & "\Documents\" & tstamp & Namer & ".pdf"
        DownloadStatus = URLDownloadToFile(0, URL, LocalFilePath, 0, 0)
        If DownloadStatus = 0 Then
            MsgBox "File Downloaded. Check in this path: " & LocalFilePath
            Sheets("Background").Range("F" & rw) = tstamp 
            Sheets("Background").Range("G" & rw) = "SAT" 
        Else
            MsgBox "Download File Process Failed"
            Sheets("Background").Range("G" & rw) = "FAIL" 
        End If
    Else
        MsgBox "The most up to date pub has been downloaded"
    End If

End Sub