VBA to add vba
Page 3 of 3 FirstFirst 123
Results 21 to 24 of 24

Thread: VBA to add vba
Thanks Thanks: 0 Likes Likes: 0

  1. #21
    Board Regular
    Join Date
    Oct 2018
    Posts
    479
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to add vba

    Didn't you write that piece for me?

  2. #22
    Board Regular Norie's Avatar
    Join Date
    Apr 2004
    Location
    Stirling, Scotland
    Posts
    75,123
    Post Thanks / Like
    Mentioned
    60 Post(s)
    Tagged
    6 Thread(s)

    Default Re: VBA to add vba

    The last code I posted didn't have that line in it but it did have a minor error, try this.
    Code:
    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
    If posting code please use code tags.

  3. #23
    Board Regular
    Join Date
    Oct 2018
    Posts
    479
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to add vba

    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?

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

  4. #24
    Board Regular
    Join Date
    Oct 2018
    Posts
    479
    Post Thanks / Like
    Mentioned
    2 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to add vba

    @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.

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

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •