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