VBA to add vba

S

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
655
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
 
Sort by date Sort by votes
brilliant! So now, the last question- can you do the same thing basically to make/show buttons and hide them when a cell in that row is empty (let's say the URL cell) and have that set to run when the workbook opens?
 
Upvote 0

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Actually this goes to two questions-1. was the buttons

2. With this code, can this macro also self-repeat. I guess meaning each row will have it's own button to run each download individually but also thinking that a single button (at the top of the activesheet) that could be clicked to run every visible button would be sweet too. Make sense?

Thanks again @Norie
 
Upvote 0
Why not have one button that goes down the rows and if there is data in a row does the download, if there isn't it skips the row?
 
Upvote 0
That would be great. However, the reason I was setting up for both was merely because the files, despite being small, are being downloaded via a very slow, intermittent satellite connection- So I wanted such that if it got halfway down and failed, I could go back and download the failed. Does that make sense? So continuing to tweak your code, here's what I have so far. What do you think?

Note: I guess these buttons need to line up perfectly with the cells, right? Is there a specific way I should be making them to line up with the cells? In the past I've just made them dimensional until they look good....

Note: I have an error here with the method for .SaveAs that I haven't overcome in my mind. I might be putting in a "transfer" piece of code instead... Welcome to ideas though. I tried to spell out each procedure here.
Code: 
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 btn As Shape
Dim rw As Long


With Sheets("Background")
    Set btn = .Shapes(Application.Caller)
    rw = btn.TopLeftCell.Row 'Should be the row the button that has been clicked on***
    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
End Sub
 
Upvote 0
Couldn't you use column G to indicate if the download has to be attempted?

If it's 'FAIL' or empty try the download, if it's 'SUCCESS' don't try the download.
 
Upvote 0
Norie said:
Couldn't you use column G to indicate if the download has to be attempted?

If it's 'FAIL' or empty try the download, if it's 'SUCCESS' don't try the download.
Click to expand...

Eh- well I used it the way I did because each week an update comes out. If the most current version (same file name) is downloaded as indicated in the Date1 check, then it will not download. That part all worked. My issue was coming in with

1. Do I use cmd buttons and have them "not visible" for the unused rows or is there a way to have the sheet dynamically add buttons when it opens if one column of cells is not empty. (e.g. if C1 is not empty, show button, If c2 is empty, keep button hidden).

2. My bigger problem- How do I properly write the piece below (it's in the middle of my big code)
Code: 
'Save temp files to replace old files.            TempFileNEW.SaveAs Filename:=LocalFilePath, FileFormat:=xlTypePDF
 
Upvote 0
Why do you want to use multiple command buttons?

Why not have one command button that goes down the list and downloads file if it need's to be downloaded?

With that approach you wouldn't need multiple buttons, something like this could work.
Code: 
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 .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 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
 
Upvote 0
I guess the reason for multiple is so that on rare occasions the user is able to begin the download of a specific pdf first if they need to.

Further, I'm using some of your code here to modify a "view" where the macro opens the downloaded file so it can be viewed.
 
Upvote 0
So I'm kicking an error "control variable already in use" and it's highlighting the "for rw = 4" line

Code: 
Sub Downloadx()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 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 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 #
            For rw = 4 To .Range("B" & Rows.Count).End(xlUp).Row
        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 & "\"
        Finalname = 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
                MyFSO.CopyFile Source:=TempFileNEW, Destination:=LocalFilePath & Finalname
                '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
 
Upvote 0
Why do you have this line of code?
Code: 
            For rw = 4 To .Range("B" & Rows.Count).End(xlUp).Row
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Move cursor to a specific cell after data has been entered
Replies
4
Views
407
Peter_SSs
Peter_SSs
excelbytes
  • Solved
Need VBA Code To Save File As To New Location With New Name
Replies
3
Views
332
6StringJazzer
6StringJazzer
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M
Z
  • Solved
Code working within a file, giving Error 448 within another file
Replies
2
Views
137
zankzank
Z
H
  • Question Question
Macro to download zip, unpack and copy data
Replies
0
Views
758
HeinrichPaul
H

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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