+ Reply to Thread
Results 1 to 2 of 2

Creating a Loop for Macro

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    04-30-2013
    Location
    arizona
    MS-Off Ver
    365
    Posts
    147

    Creating a Loop for Macro

    So I found this code which loops through and opens up a url for every address that is listed in Column C (starting with row 8 and then saves it according to the folder location that is listed in cell B4. Each file is named according to the name which is in the column right next to it. So for example if I have 3 url addresses listed in rows 8,9, and 10 then I will end up with 3 saved web pages all saved in the folder identified in cell B4.

    So what I am trying to do is to give each URL a different file location to be saved to. So instead of saving all pages to the same folder it will be saved to individual folders. I would like to use Column B as the location for the folder addresses.

    Does anyone know how to help with this?




    Sub URLToPDF()
                        
        'Loops throuhg all the urls at column C and print the web
        'pages as PDF using Adobe Professional.
        'This is the main sub that calls the rest subs.
                
        'By Christos Samaras
        'http://www.myengineeringworld.net
        
        Dim PDFFolder           As String
        Dim LastRow             As Long
        Dim arrSpecialChar()    As String
        Dim dblSpCharFound      As Double
        Dim PDFPath             As String
        Dim i                   As Long
        Dim j                   As Integer
        
        'An array with special characters that cannot be used for naming a file.
        arrSpecialChar() = Split("\ / : * ? " & Chr$(34) & " < > |", " ")
        
        'Find the last row.
         With Worksheets("Main")
            .Activate
            LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        End With
        
        'Check if the PDF's folder exists.
        PDFFolder = Worksheets("Main").Range("B4").Value
        If FolderExists(PDFFolder) = False Or PDFFolder = "" Then
            MsgBox "The PDF folder's path is incorect!", vbCritical, "Wrong path"
            Worksheets("Main").Range("B4").Select
            Exit Sub
        End If
                   
        'Check if there is at least one URL.
        If LastRow < 8 Then
            MsgBox "You did't enter a URL!", vbCritical, "No URL"
            Exit Sub
        End If
        
        'Add the backslash if not exists.
        If Right(PDFFolder, 1) <> "\" Then
            PDFFolder = PDFFolder & "\"
        End If
                
        'Convert the URLs to PDFs.
        For i = 8 To LastRow
            On Error Resume Next
            PDFPath = Cells(i, 4).Value
            'Check if the PDF name contains a special/illegal character.
            For j = LBound(arrSpecialChar) To UBound(arrSpecialChar)
                dblSpCharFound = WorksheetFunction.Find(arrSpecialChar(j), PDFPath)
                If dblSpCharFound > 0 Then
                    PDFPath = WorksheetFunction.Substitute(PDFPath, arrSpecialChar(j), "-")
                End If
            Next j
            PDFPath = PDFFolder & PDFPath
            On Error GoTo 0
            'Save the PDF files to the selected folder.
            Call WebpageToPDF(Cells(i, 3).Value, PDFPath & ".pdf")
        Next i
        
        'Inform the user that macro finished.
        MsgBox LastRow - 7 & " web pages were successfully saved as PDFs!", vbInformation, "Done"
        
    End Sub

  2. #2
    Forum Expert
    Join Date
    10-09-2012
    Location
    Dallas, Texas
    MS-Off Ver
    MO 2010 & 2013
    Posts
    3,049

    Re: Creating a Loop for Macro

    You need to include the defining of the variable PDFFolder in the loop as follows

    Sub URLToPDF()  
        
    	Dim PDFFolder           As String
        Dim LastRow             As Long
        Dim arrSpecialChar()    As String
        Dim dblSpCharFound      As Double
        Dim PDFPath             As String
        Dim i                   As Long
        Dim j                   As Integer
        
        'An array with special characters that cannot be used for naming a file.
        arrSpecialChar() = Split("\ / : * ? " & Chr$(34) & " < > |", " ")
        
        'Find the last row.
         With Worksheets("Main")
            .Activate
            LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        End With
    	
        'Check if there is at least one URL.
        If LastRow < 8 Then
            MsgBox "You did't enter a URL!", vbCritical, "No URL"
            Exit Sub
        End If
        
        'Convert the URLs to PDFs.
        For i = 8 To LastRow
            
            On Error Resume Next
            
            PDFPath = Cells(i, 4).Value
            PDFFolder = Cells(i, 2).Value
    			If Right(PDFFolder, 1) <> "\" Then 
    				PDFFolder = PDFFolder & "\"
    				cells(i,2).value = PDFFolder
    			End if
            
    		'Check if the PDF name contains a special/illegal character.
            For j = LBound(arrSpecialChar) To UBound(arrSpecialChar)
                dblSpCharFound = WorksheetFunction.Find(arrSpecialChar(j), PDFPath)
                If dblSpCharFound > 0 Then
                    PDFPath = WorksheetFunction.Substitute(PDFPath, arrSpecialChar(j), "-")
                End If
            Next j
            PDFPath = PDFFolder & PDFPath
            On Error GoTo 0
            'Save the PDF files to the selected folder.
            Call WebpageToPDF(Cells(i, 3).Value, PDFPath & ".pdf")
        Next i
        
        'Inform the user that macro finished.
        MsgBox LastRow - 7 & " web pages were successfully saved as PDFs!", vbInformation, "Done"
    End Sub
    Please ensure you mark your thread as Solved once it is. Click here to see how.
    If a post helps, please don't forget to add to our reputation by clicking the star icon in the bottom left-hand corner of a post.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. creating a loop in a macro
    By bobfoley91 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 03-20-2014, 08:33 AM
  2. [SOLVED] Need help creating a loop in a macro!!!!
    By moshro1 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-14-2013, 01:46 PM
  3. Creating a Macro / GUI that is continuous and does not loop
    By C Dev in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 07-26-2012, 04:45 AM
  4. Question on Creating Loop type Macro
    By mavrik5150 in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 09-07-2011, 02:20 PM
  5. Creating a Continuous Loop Macro
    By Hyflex in forum Excel General
    Replies: 4
    Last Post: 09-21-2010, 08:46 AM

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1