Help w/simple two step macro - Excel 2013

[bman84]

Hey there, I'm using Excel 2013, and hoping you can help me piece together the code to create a simple macro. I have an Excel spreadsheet that acts as a simple statement generator by populating a number of cells based on a VLOOKUP against a master list of account numbers.

The user enters the 4-digit account number, and the VLOOKUP formulas on a separate tab of the workbook bring back the required values (ie. Customer Name, Address, Balance, etc) from the master list.

Rather than have the user spend time entering an account number, and manually saving a PDF, I'm hoping to create a macro that does those steps for them. Desired process would look like this:

1) User pastes list of account numbers in COLUMN L on 'Entry' sheet
2) User enters a desired file path in cell A5 (location where PDF's will be saved)
3) User clicks a button to start the macro
4) Macro reads first account number in COLUMN L and writes it to cell H7
5) Macro moves to separate sheet called 'Renewal Letter' and saves the sheet as a PDF, with the same filename as the text in cell K6
6) Macro moves back to 'Entry' and writes the next account number from COLUMN L to cell H7
....and the loop of steps 5) and 6) continues until the entire list in COLUMN L has been completed


Thanks in advance for any help!

 

[bman84]

Amazing, works now, thanks so much! I realized I was missing the path shortly after posting, and entered it, but was still getting the error. I guess it didn't like the format that I entered the path? Probably best to stick with your popup box instead anyway as it's more user friendly.

Thanks again, you've saved me hours of work!

That means that A5 on the Entry sheet (where the path was supposed to be entered) is blank.

I updated my code to be more accomodating and prompt for the path if it is not available in A5.
I also placed a little more error conditioning around the ExportAsFixedFormat line so THAT line won't error out anymore.

Let me know if you are still having problems.

Sub Export2PDF()
Dim LookupArr As Variant
Dim i As Long
Dim filePath As String, fileName As String
Dim wsEntry As Worksheet, wsPrint As Worksheet
Dim AutoOpen As Boolean
PDFAutoOpen = False    'change this to TRUE if you want the PDF documents to open after being saved
Set wsEntry = ThisWorkbook.Sheets("Entry")
Set wsPrint = ThisWorkbook.Sheets("Renewal Letter")
    LookupArr = Application.Transpose(wsEntry.Range("L2:L" & wsEntry.Range("L" & Rows.Count).End(xlUp).Row).Value)
    filePath = wsEntry.Range("A5").Value
    
    If filePath = "" Then
        Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
        With fldr
            .Title = "Select a Folder"
            .AllowMultiSelect = False
            .InitialFileName = ThisWorkbook.Path
            If .Show <> -1 Then
                Exit Sub    'user hit Cancel
            End If
            filePath = .SelectedItems(1)
        End With
    End If
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"
    
    For i = LBound(LookupArr) To UBound(LookupArr)
        wsEntry.Range("H7").Value = LookupArr(i)
        Application.Calculate   'ensure that all formulas are updated
        fileName = wsPrint.Range("K6").Value
        wsPrint.Activate
        On Error Resume Next
        wsPrint.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath & fileName, IgnorePrintAreas:=False, OpenAfterPublish:=PDFAutoOpen
        On Error GoTo 0
        If Dir(filePath & fileName & "*") = "" Then
            MsgBox "Could NOT save " & filePath & fileName, vbCritical + vbOKOnly, "Error Exporting PDF"
        End If
        DoEvents    'let's Adobe finish with the file
    Next i
    
Set wsEntry = Nothing
Set wsPrint = Nothing
End Sub

 

[BiocideJ]

Great. Glad to hear it is working.

If you are not going to expect the user to fill in A5, I suggest you remove the code that tries to read from that cell so that if someone at some points puts something in A5 in doesn't bother the code any.

Sub Export2PDF()
Dim LookupArr As Variant
Dim i As Long
Dim filePath As String, fileName As String
Dim wsEntry As Worksheet, wsPrint As Worksheet
Dim AutoOpen As Boolean
PDFAutoOpen = False    'change this to TRUE if you want the PDF documents to open after being saved
Set wsEntry = ThisWorkbook.Sheets("Entry")
Set wsPrint = ThisWorkbook.Sheets("Renewal Letter")
    LookupArr = Application.Transpose(wsEntry.Range("L2:L" & wsEntry.Range("L" & Rows.Count).End(xlUp).Row).Value)
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then
            Exit Sub    'user hit Cancel
        End If
        filePath = .SelectedItems(1)
    End With
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"
    
    For i = LBound(LookupArr) To UBound(LookupArr)
        wsEntry.Range("H7").Value = LookupArr(i)
        Application.Calculate   'ensure that all formulas are updated
        fileName = wsPrint.Range("K6").Value
        wsPrint.Activate
        On Error Resume Next
        wsPrint.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath & fileName, IgnorePrintAreas:=False, OpenAfterPublish:=PDFAutoOpen
        On Error GoTo 0
        If Dir(filePath & fileName & "*") = "" Then
            MsgBox "Could NOT save " & filePath & fileName, vbCritical + vbOKOnly, "Error Exporting PDF"
        End If
        DoEvents    'let's Adobe finish with the file
    Next i
    
Set wsEntry = Nothing
Set wsPrint = Nothing
End Sub

 

[bman84]

So follow up to this. How hard would it be to have excel take each saved PDF and send it to the customer's email?

For example, email PDF to address listed in Entry sheet cell B18, BCC to address listed in B19, and include text in cell B20 as the body of the email?

Great. Glad to hear it is working.

If you are not going to expect the user to fill in A5, I suggest you remove the code that tries to read from that cell so that if someone at some points puts something in A5 in doesn't bother the code any.

Sub Export2PDF()
Dim LookupArr As Variant
Dim i As Long
Dim filePath As String, fileName As String
Dim wsEntry As Worksheet, wsPrint As Worksheet
Dim AutoOpen As Boolean
PDFAutoOpen = False    'change this to TRUE if you want the PDF documents to open after being saved
Set wsEntry = ThisWorkbook.Sheets("Entry")
Set wsPrint = ThisWorkbook.Sheets("Renewal Letter")
    LookupArr = Application.Transpose(wsEntry.Range("L2:L" & wsEntry.Range("L" & Rows.Count).End(xlUp).Row).Value)
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then
            Exit Sub    'user hit Cancel
        End If
        filePath = .SelectedItems(1)
    End With
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"
    
    For i = LBound(LookupArr) To UBound(LookupArr)
        wsEntry.Range("H7").Value = LookupArr(i)
        Application.Calculate   'ensure that all formulas are updated
        fileName = wsPrint.Range("K6").Value
        wsPrint.Activate
        On Error Resume Next
        wsPrint.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath & fileName, IgnorePrintAreas:=False, OpenAfterPublish:=PDFAutoOpen
        On Error GoTo 0
        If Dir(filePath & fileName & "*") = "" Then
            MsgBox "Could NOT save " & filePath & fileName, vbCritical + vbOKOnly, "Error Exporting PDF"
        End If
        DoEvents    'let's Adobe finish with the file
    Next i
    
Set wsEntry = Nothing
Set wsPrint = Nothing
End Sub

 

[BiocideJ]

Is Outlook your e-mail program I assume?
Also, just to verify, each e-mail would have a single PDF document?

 

[bman84]

Yes to Outlook, and yes to a single PDF per email.

 

[BiocideJ]

OK, with e-mailing capabilities added. I already had a generic e-mail function written for something else I run so I am using that and only had to modify it slightly.
You can set whether you want the e-mails to go out automatically by changing the oAutoSend variable to TRUE. I would leave it as False for now while testing until you are very confident it is going to work properly.

You need to add a reference to the Microsoft Outlook X.0 Object Library (where X is the highest number available)
If you haven't done this before, from the VBA Project window, select Tools>Reference and check the box for the item you wish to add.


I expect cells B18:B20 to be formulas that are updating automatically (unless they always go to the same recipients).

I had to add a check to make sure the filename from K6 ends in ".pdf" and add it if not.
You will need to enter what you want the Subject line of the e-mail to be by replacing
{Enter the preferred subject of the e-mail here}

All that being said, here is the updated code

Sub Export2PDF()
Dim LookupArr As Variant
Dim i As Long
Dim filePath As String, fileName As String
Dim wsEntry As Worksheet, wsPrint As Worksheet
Dim AutoOpen As Boolean, oAutoSend As Boolean
Dim xlTo As String, xlCC As String, xlBCC As String
Dim xlSubject As String, xlHTMLBody As String
PDFAutoOpen = False     'change this to TRUE if you want the PDF documents to open after being saved
oAutoSend = False        'change this to TRUE if you want to send e-mails automatically (no preview)
Set wsEntry = ThisWorkbook.Sheets("Entry")
Set wsPrint = ThisWorkbook.Sheets("Renewal Letter")
    LookupArr = Application.Transpose(wsEntry.Range("L2:L" & wsEntry.Range("L" & Rows.Count).End(xlUp).Row).Value)
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then
            Exit Sub    'user hit Cancel
        End If
        filePath = .SelectedItems(1)
    End With
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"
    
    For i = LBound(LookupArr) To UBound(LookupArr)
        wsEntry.Range("H7").Value = LookupArr(i)
        Application.Calculate   'ensure that all formulas are updated
        fileName = wsPrint.Range("K6").Value
        If Right(fileName, 4) <> ".pdf" Then fileName = fileName & ".pdf"
        wsPrint.Activate
        On Error Resume Next
        wsPrint.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath & fileName, IgnorePrintAreas:=False, OpenAfterPublish:=PDFAutoOpen
        On Error GoTo 0
        If Dir(filePath & fileName) = "" Then
            MsgBox "Could NOT save " & filePath & fileName, vbCritical + vbOKOnly, "Error Exporting PDF"
        End If
        DoEvents    'let's Adobe finish with the file
        
        
        xlTo = wsEntry.Range("B18").Value
        xlCC = ""   'not used
        xlBCC = wsEntry.Range("B19").Value
        xlSubject = "{Enter the preferred subject of the e-mail here}"
        xlHTMLBody = wsEntry.Range("B20").Value
        With CreateEmail(xlTo, xlCC, xlBCC, xlSubject, xlHTMLBody, filePath & fileName)
            If oAutoSend Then .Send 'create and auto-send
        End With
        
    Next i
    
Set wsEntry = Nothing
Set wsPrint = Nothing
End Sub
Function CreateEmail(oTo As String, oCC As String, oBCC As String, oSubject As String, Optional oHTMLBody As String, Optional oAttachFile As String) As Outlook.MailItem
'write the default Outlook contact name list to the active worksheet
Dim OlApp As Outlook.Application
Dim OlMail As Outlook.MailItem
Dim ToRecipient As Variant
Dim CcRecipient As Variant
    Set OlApp = New Outlook.Application
    Set OlMail = OlApp.CreateItem(olMailItem)
    
    For Each ToRecipient In Split(oTo, ";")
        If ToRecipient <> "" Then OlMail.Recipients.Add ToRecipient
    Next ToRecipient
    
    For Each CcRecipient In Split(oCC, ";")
        If CcRecipient <> "" Then
            With OlMail.Recipients.Add(CcRecipient)
                .Type = olCC '2
            End With
        End If
    Next CcRecipient
    
    For Each BccRecipient In Split(oBCC, ";")
        If BccRecipient <> "" Then
            With OlMail.Recipients.Add(BccRecipient)
                .Type = olBCC '3
            End With
        End If
    Next BccRecipient
    'fill in Subject field
    OlMail.Subject = oSubject
    
    OlMail.Display  'display so the signature populates
    
    'Add the specified file path as an attachment
    OlMail.Attachments.Add oAttachFile
    'Add data to the body
    oHTMLBody = Replace(oHTMLBody, Chr(13), "<BR>") 'replace Excel line breaks with HTML line breaks
    OlMail.HTMLBody = oHTMLBody & OlMail.HTMLBody 'Preserve signature if it existed
    Set CreateEmail = OlMail
    
End Function

 

[bman84]

Thanks, inserted the reference but still received an error stating 'Compile error: User -defined type not defined'

OK, with e-mailing capabilities added. I already had a generic e-mail function written for something else I run so I am using that and only had to modify it slightly.
You can set whether you want the e-mails to go out automatically by changing the oAutoSend variable to TRUE. I would leave it as False for now while testing until you are very confident it is going to work properly.

You need to add a reference to the Microsoft Outlook X.0 Object Library (where X is the highest number available)
If you haven't done this before, from the VBA Project window, select Tools>Reference and check the box for the item you wish to add.


I expect cells B18:B20 to be formulas that are updating automatically (unless they always go to the same recipients).

I had to add a check to make sure the filename from K6 ends in ".pdf" and add it if not.
You will need to enter what you want the Subject line of the e-mail to be by replacing
{Enter the preferred subject of the e-mail here}

All that being said, here is the updated code

Sub Export2PDF()
Dim LookupArr As Variant
Dim i As Long
Dim filePath As String, fileName As String
Dim wsEntry As Worksheet, wsPrint As Worksheet
Dim AutoOpen As Boolean, oAutoSend As Boolean
Dim xlTo As String, xlCC As String, xlBCC As String
Dim xlSubject As String, xlHTMLBody As String
PDFAutoOpen = False     'change this to TRUE if you want the PDF documents to open after being saved
oAutoSend = False        'change this to TRUE if you want to send e-mails automatically (no preview)
Set wsEntry = ThisWorkbook.Sheets("Entry")
Set wsPrint = ThisWorkbook.Sheets("Renewal Letter")
    LookupArr = Application.Transpose(wsEntry.Range("L2:L" & wsEntry.Range("L" & Rows.Count).End(xlUp).Row).Value)
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then
            Exit Sub    'user hit Cancel
        End If
        filePath = .SelectedItems(1)
    End With
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"
    
    For i = LBound(LookupArr) To UBound(LookupArr)
        wsEntry.Range("H7").Value = LookupArr(i)
        Application.Calculate   'ensure that all formulas are updated
        fileName = wsPrint.Range("K6").Value
        If Right(fileName, 4) <> ".pdf" Then fileName = fileName & ".pdf"
        wsPrint.Activate
        On Error Resume Next
        wsPrint.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath & fileName, IgnorePrintAreas:=False, OpenAfterPublish:=PDFAutoOpen
        On Error GoTo 0
        If Dir(filePath & fileName) = "" Then
            MsgBox "Could NOT save " & filePath & fileName, vbCritical + vbOKOnly, "Error Exporting PDF"
        End If
        DoEvents    'let's Adobe finish with the file
        
        
        xlTo = wsEntry.Range("B18").Value
        xlCC = ""   'not used
        xlBCC = wsEntry.Range("B19").Value
        xlSubject = "{Enter the preferred subject of the e-mail here}"
        xlHTMLBody = wsEntry.Range("B20").Value
        With CreateEmail(xlTo, xlCC, xlBCC, xlSubject, xlHTMLBody, filePath & fileName)
            If oAutoSend Then .Send 'create and auto-send
        End With
        
    Next i
    
Set wsEntry = Nothing
Set wsPrint = Nothing
End Sub
Function CreateEmail(oTo As String, oCC As String, oBCC As String, oSubject As String, Optional oHTMLBody As String, Optional oAttachFile As String) As Outlook.MailItem
'write the default Outlook contact name list to the active worksheet
Dim OlApp As Outlook.Application
Dim OlMail As Outlook.MailItem
Dim ToRecipient As Variant
Dim CcRecipient As Variant
    Set OlApp = New Outlook.Application
    Set OlMail = OlApp.CreateItem(olMailItem)
    
    For Each ToRecipient In Split(oTo, ";")
        If ToRecipient <> "" Then OlMail.Recipients.Add ToRecipient
    Next ToRecipient
    
    For Each CcRecipient In Split(oCC, ";")
        If CcRecipient <> "" Then
            With OlMail.Recipients.Add(CcRecipient)
                .Type = olCC '2
            End With
        End If
    Next CcRecipient
    
    For Each BccRecipient In Split(oBCC, ";")
        If BccRecipient <> "" Then
            With OlMail.Recipients.Add(BccRecipient)
                .Type = olBCC '3
            End With
        End If
    Next BccRecipient
    'fill in Subject field
    OlMail.Subject = oSubject
    
    OlMail.Display  'display so the signature populates
    
    'Add the specified file path as an attachment
    OlMail.Attachments.Add oAttachFile
    'Add data to the body
    oHTMLBody = Replace(oHTMLBody, Chr(13), "
") 'replace Excel line breaks with HTML line breaks
    OlMail.HTMLBody = oHTMLBody & OlMail.HTMLBody 'Preserve signature if it existed
    Set CreateEmail = OlMail
    
End Function

 

[BiocideJ]

Which exactly is the reference you added and which line of code is flagging?

 

[bman84]

Sorry, added the wrong reference. Still getting a different error now though. "Run-time error '13': Type mismatch" for this line:


For i = LBound(LookupArr) To UBound(LookupArr)

 

[BiocideJ]

This was actually a conceptual oversight on my part when I set up the array. I assume that you only had one entry in column L for this to happen.
This 'further' amended code should error check and keep the array structure even when there is only one value...

changed code is highlighted in red.

Sub Export2PDF()
Dim LookupArr As Variant
Dim i As Long
Dim filePath As String, fileName As String
Dim wsEntry As Worksheet, wsPrint As Worksheet
Dim AutoOpen As Boolean, oAutoSend As Boolean
Dim xlTo As String, xlCC As String, xlBCC As String
Dim xlSubject As String, xlHTMLBody As String
PDFAutoOpen = False     'change this to TRUE if you want the PDF documents to open after being saved
oAutoSend = False        'change this to TRUE if you want to send e-mails automatically (no preview)
Set wsEntry = ThisWorkbook.Sheets("Entry")
Set wsPrint = ThisWorkbook.Sheets("Renewal Letter")
    If wsEntry.Range("L" & Rows.Count).End(xlUp).Row <= 2 Then
        LookupArr = Array(Range("L2").Value)
    Else
        LookupArr = Application.Transpose(wsEntry.Range("L2:L" & wsEntry.Range("L" & Rows.Count).End(xlUp).Row).Value)
    End If
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then
            Exit Sub    'user hit Cancel
        End If
        filePath = .SelectedItems(1)
    End With
    If Right(filePath, 1) <> "\" Then filePath = filePath & "\"
    
    For i = LBound(LookupArr) To UBound(LookupArr)
        wsEntry.Range("H7").Value = LookupArr(i)
        Application.Calculate   'ensure that all formulas are updated
        fileName = wsPrint.Range("K6").Value
        If Right(fileName, 4) <> ".pdf" Then fileName = fileName & ".pdf"
        wsPrint.Activate
        On Error Resume Next
        wsPrint.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath & fileName, IgnorePrintAreas:=False, OpenAfterPublish:=PDFAutoOpen
        On Error GoTo 0
        If Dir(filePath & fileName) = "" Then
            MsgBox "Could NOT save " & filePath & fileName, vbCritical + vbOKOnly, "Error Exporting PDF"
        End If
        DoEvents    'let's Adobe finish with the file
        
        
        xlTo = wsEntry.Range("B18").Value
        xlCC = ""   'not used
        xlBCC = wsEntry.Range("B19").Value
        xlSubject = "{Enter the preferred subject of the e-mail here}"
        xlHTMLBody = wsEntry.Range("B20").Value
        With CreateEmail(xlTo, xlCC, xlBCC, xlSubject, xlHTMLBody, filePath & fileName)
            If oAutoSend Then .Send 'create and auto-send
        End With
        
    Next i
    
Set wsEntry = Nothing
Set wsPrint = Nothing
End Sub
Function CreateEmail(oTo As String, oCC As String, oBCC As String, oSubject As String, Optional oHTMLBody As String, Optional oAttachFile As String) As Outlook.MailItem
'write the default Outlook contact name list to the active worksheet
Dim OlApp As Outlook.Application
Dim OlMail As Outlook.MailItem
Dim ToRecipient As Variant
Dim CcRecipient As Variant
    Set OlApp = New Outlook.Application
    Set OlMail = OlApp.CreateItem(olMailItem)
    
    For Each ToRecipient In Split(oTo, ";")
        If ToRecipient <> "" Then OlMail.Recipients.Add ToRecipient
    Next ToRecipient
    
    For Each CcRecipient In Split(oCC, ";")
        If CcRecipient <> "" Then
            With OlMail.Recipients.Add(CcRecipient)
                .Type = olCC '2
            End With
        End If
    Next CcRecipient
    
    For Each BccRecipient In Split(oBCC, ";")
        If BccRecipient <> "" Then
            With OlMail.Recipients.Add(BccRecipient)
                .Type = olBCC '3
            End With
        End If
    Next BccRecipient
    'fill in Subject field
    OlMail.Subject = oSubject
    
    OlMail.Display  'display so the signature populates
    
    'Add the specified file path as an attachment
    OlMail.Attachments.Add oAttachFile
    'Add data to the body
    oHTMLBody = Replace(oHTMLBody, Chr(13), "<BR>") 'replace Excel line breaks with HTML line breaks
    OlMail.HTMLBody = oHTMLBody & OlMail.HTMLBody 'Preserve signature if it existed
    Set CreateEmail = OlMail
    
End Function