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

 

[trunten]

I can't check this as I'm on a Mac, but I would have thought this would work for you:

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

 

[MarkR3003]

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

 

[Fluff]

If you make the change in red, what happens

        strPath = Environ$("temp") & [COLOR=#ff0000]"\"[/COLOR] 'Or any other path, but include trailing ""

 

[MarkR3003]

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

 

[Fluff]

In that case remove this line

On Error Resume Next

and see what happens.

 

[Kenneth Hobson]

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.

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

 

[MarkR3003]

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

 

[Kenneth Hobson]

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:

'If Range("R13").Value = 3 Then
If Range("R13").Value [COLOR="#FF0000"]<[/COLOR]= 3 Then

 

[MarkR3003]

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