VBA to create PDF's of two worksheets when a condition is met

MarkR3003

New Member
Joined
Aug 11, 2019
Messages
25
Hi,

I hope that you can help me once again....

I have a VBA code which produces a PDF of a worksheet and attaches it to an email (with other details in the email found in the worksheet) when a single condition is met in cell Y32 of the active worksheet.

I want to add some additional VBA to create a PDF of another worksheet ("Support Calculator") and add it to the same email with the first PDF attachment when the two conditions in the active worksheet are met, otherwise, only create the first PDF and revert to the VBA shown below:

Condition 1: Y32 = "OK"
Condition 2: R13 = "3"

The current VBA which works well is shown below:


Sub SEND_FORM()
' Check all Mandatory fields are complete

If (Range("Y32") = "OK") Then

Dim strPath As String,strFName As String
Dim OutApp As Object, OutMailAs Object

'Create PDF of active sheetonly

strPath =Environ$("temp") & "" 'Or any other path, but includetrailing ""

strFName =ActiveWorkbook.Name
strFName =Range("Q9") & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName,Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False,OpenAfterPublish:=False

'Set up outlook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail =OutApp.CreateItem(0)

'Create message

On Error Resume Next
With OutMail
.to =Range("Q13")
.CC =Range("Q14")
.Subject =Range("Q9")
.Body =Range("Q16")
.Attachments.Add strPath & strFName
.Display 'Use only during debugging##############################
'.Send 'Uncomment to send e-mail##############################
End With
'Delete any temp filescreated
Kill strPath & strFName
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

Else

MsgBox ("Please completeall mandatory fields shown in bold red text before sending for action orauthorisation." & vbNewLine & "" & vbNewLine &"An application cannot include XXX and YYY products in the same form. Please submit seperate application forms for each brand")

End If
End Sub

Many thanks for your valuable assistance

Mark
 
Last edited:

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
I can't check this as I'm on a Mac, but I would have thought this would work for you:

Code:
Sub SEND_FORM()
    Dim strPath As String, strFName(1 To 2) As String
    Dim OutApp As Object, OutMail As Object
    
    'Check all mandatory fields are complete
    If (Range("Y32").Value = "OK") Then
        strPath = Environ$("temp") & "" 'Or any other path, but include trailing ""
        'strFName(1) = ActiveWorkbook.Name '<--What is this doing??
        strFName(1) = strPath & Range("Q9") & ".pdf"
        
        'Export active sheet as PDF
        ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=strFName(1), _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
          
        'Export Support Calculator if condition met
        If Range("R13").Value = "3" Then
            strFName(2) = strPath & "Support Calculator.pdf"
            Sheets("Support Calculator").ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    FileName:=strFName(1), _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
        End If
    
        'Set up outlook
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        'Create message
        On Error Resume Next
        With OutMail
            .To = Range("Q13")
            .CC = Range("Q14")
            .Subject = Range("Q9")
            .Body = Range("Q16")
            .Attachments.Add strFName(1)
            If LenB(strFName(2)) Then .Attachments.Add strFName(2)
            .Display 'Use only during debugging##############################
            '.Send 'Uncomment to send e-mail##############################
        End With
        'Delete any temp filescreated
        Kill strFName(1)
        If LenB(strFName(2)) Then Kill strFName(2)
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
    Else
        MsgBox ("Please complete all mandatory fields shown " & _
                "in bold red text before sending for action " & _
                "or authorisation." & vbNewLine & "" & vbNewLine & _
                "An application cannot include XXX and YYY " & _
                "products in the same form. Please submit " & _
                "seperate application forms for each brand")
    End If
End Sub
 
Upvote 0
Many thanks for the quick reply.

The code doesnt produce any results or error message / bug error so Im not sure which part of the code needs looking into.

Appreciate any suggestions you may have
 
Upvote 0
If you make the change in red, what happens
Code:
        strPath = Environ$("temp") & [COLOR=#ff0000]"\"[/COLOR] 'Or any other path, but include trailing ""
 
Upvote 0
Hi Fluff

Thanks for the reply. Still no result but still no error / bug message. The screen flickers with some activity but nothing else

Mark
 
Upvote 0
In that case remove this line
Code:
On Error Resume Next
and see what happens.
 
Upvote 0
I tweaked code in #2 a bit. Since you did not attach a simple example file, I did not test it. If the same problem, do what Fluff said and retry.


Code:
Sub SEND_FORM()
    Dim strPath As String, strFName(1 To 2) As String
    Dim OutApp As Object, OutMail As Object
    
    'Check all mandatory fields are complete
    If Range("Y32").Value = "OK" Then
        strPath = Environ$("temp") & "[COLOR="#FF0000"]\[/COLOR]" 'Or any other path, but include trailing ""
        'strFName(1) = ActiveWorkbook.Name '<--What is this doing??
        strFName(1) = strPath & Range("Q9") & ".pdf"
        
        'Export active sheet as PDF
        ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=strFName(1), _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
          
        'Export Support Calculator if condition met
        If Range("R13").Value = [COLOR="#FF0000"]3 [/COLOR]Then
            strFName(2) = strPath & "Support Calculator.pdf"
            Sheets("Support Calculator").ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    Filename:=strFName([COLOR="#FF0000"]2[/COLOR]), _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
        End If
    
        'Set up outlook
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        'Create message
        On Error Resume Next
        With OutMail
            .To = Range("Q13")
            .CC = Range("Q14")
            .Subject = Range("Q9")
            .Body = Range("Q16")
            If[COLOR="#FF0000"] Dir(strFName(1)) <> ""[/COLOR] Then .Attachments.Add strFName(1)
            If[COLOR="#FF0000"] Dir(strFName(2)) <> ""[/COLOR] Then .Attachments.Add strFName([COLOR="#FF0000"]2[/COLOR])
            .Display 'Use only during debugging##############################
            '.Send 'Uncomment to send e-mail##############################
        End With
        'Delete any temp filescreated
        [COLOR="#FF0000"]If Dir(strFName(1)) <> "" Then Kill strFName(1)
        If Dir(strFName(2)) <> "" Then Kill strFName(2)[/COLOR]
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
    Else
        MsgBox ("Please complete all mandatory fields shown " & _
                "in bold red text before sending for action " & _
                "or authorisation." & vbNewLine & "" & vbNewLine & _
                "An application cannot include XXX and YYY " & _
                "products in the same form. Please submit " & _
                "seperate application forms for each brand")
    End If
End Sub
 
Last edited:
Upvote 0
Hi Kenneth

Thanks for your help

The code works now for when the value = 3. However, if the value is <3 (other values are 1 or 2), the active workbook single PDF is not created and the email is not produced

Mark
 
Upvote 0
I am not sure what conditions you want. The first IF will produce 1st pdf and send an email. The 2nd IF creates the 2nd pdf and the email gets both attachments. If neither IF is true, then no email.

If you want the 2nd to be:
If Range("Y32").Value = "OK" and Range("R13").Value <= 3, then add the less than sign:
Code:
'If Range("R13").Value = 3 Then
If Range("R13").Value [COLOR="#FF0000"]<[/COLOR]= 3 Then
 
Upvote 0
The two conditions are:

If Range ("R13").Value = 3 Then 'produce the 1st (active workbook) and 2nd PDF (Support Calculator) and the email gets both attachments
If Range ("R13").Value = 1 or 2 Then 'produce only 1st PDF and the email gets only the 1st attachment

Is this possible?

Thanks
 
Upvote 0

Forum statistics

Threads
1,213,533
Messages
6,114,179
Members
448,554
Latest member
Gleisner2

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