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

[MarkR3003]

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

 

[Kenneth Hobson]

Yes, but there is no condition 1 as in post #1? Y32 = "OK"

 

[MarkR3003]

Apologies for the confusion.

The condition Y32="OK" is a seperate instruction to the create PDF/Email code as this initial step checks whether the appropriate cells have been completed resulting in Y32="OK" before allowing the rest of the code to progress towards the PDF/Email creation

 

[Kenneth Hobson]

Sub SEND_FORM3()
    Dim strPath As String, a, i As Integer
    Dim OutApp As Object, OutMail As Object
       
    strPath = Environ$("temp") & "\" 'Or any other path, but include trailing ""
        
    'Check all mandatory fields are complete
    If Range("Y32").Value <> "OK" Then
        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")
        Exit Sub
    End If
    
    If Range("R13") = 1 Or Range("R13") = 2 Then
        ReDim a(1 To 1)
        a(1) = strPath & Range("Q9") & ".pdf"
        'Export active sheet as PDF
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=a(1), _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    End If
    
    'Export Support Calculator if condition met
    If Range("R13").Value = 3 Then
        ReDim Preserve a(1 To 2)
        a(2) = strPath & "Support Calculator.pdf"
        Sheets("Support Calculator").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=a(2), _
            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")
        For i = 1 To UBound(a)
            If Dir(a(i)) <> "" Then .Attachments.Add a(i)
        Next i
        .Display 'Use only during debugging##############################
        '.Send 'Uncomment to send e-mail##############################
    End With
    
    'Delete any temp files created
    For i = 1 To UBound(a)
        If Dir(a(i)) <> "" Then Kill a(i)
    Next i
    
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub