ByRef Argument Type Mismatch

[Johnboy]

I need to send product in PDF, I found the following code, works great until I add MyArr. MyArr is list of email address for the To: block. Now I get Compile Error: ByRef Argument Type Mismatch and not sure how fix. Thanks

Sub Send_Slides()
Dim FileName As String
Dim MyArr As Variant
MyArr = ThisWorkbook.Sheets(“recap”).Range(“q1:q100”)

'Call the function with the correct arguments
FileName = Create_PDF(ActiveWorkbook, “C:\Slides\Daily Slides\" + Worksheets(“recap”).Range(“j3”), True, False)
If FileName <> "" Then
Mail_PDF_Outlook FileName, MyArr, “Daily Slides " + Worksheets(“recap”).Range(“j1”), _
“ALCON, " _
& vbNewLine & vbNewLine & “Daily Slides for " + Worksheets(“recap”).Range(“j1”) + " attached." _
& vbNewLine & vbNewLine & "", False
Else
MsgBox “Not possible to create the PDF, possible reasons:" & vbNewLine & _
“Microsoft Add-in is not installed” & vbNewLine & _
“You Canceled the GetSaveAsFilename dialog” & vbNewLine & _
“The path to Save the file in arg 2 is not correct” & vbNewLine & _
“You didn’t want to overwrite the existing PDF if it exist”
End If
End Sub

Function Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
StrSubject As String, StrBody As String, Send As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject(“Outlook.Application”)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function

 

[Worf]

Hello

I could not perform a complete test because you didn't post the Create_PDF function. Can you do that?

Anyway, the following should work. If you need further explanation on the code please ask.

Sub Send_Slides()
Dim FileName$, i%, ts$, ws As Worksheet


Set ws = ThisWorkbook.Worksheets("recap")


FileName = Create_PDF(ActiveWorkbook, "C:\Slides\Daily Slides\" + ws.Range("j3"), True, False)
If FileName <> "" Then


    For i = 1 To 3      ' adjust maximum index to suit
                        ' calls function for each mail address at column 17(Q)
        Mail_PDF_Outlook FileName, ws.Cells(1, 17).Offset(i - 1, 0).Value, "Daily Slides " + _
        ws.Range("j1"), "ALCON, """ & vbNewLine & vbNewLine & "Daily Slides for " + _
        ws.Range("j1") + " attached." & vbNewLine & vbNewLine & "", False
    Next
Else
    MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
    "Microsoft Add-in is not installed" & vbNewLine & _
    "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
    "The path to Save the file in arg 2 is not correct" & vbNewLine & _
    "You didn’t want to overwrite the existing PDF if it exist"
End If
End Sub


Function Create_PDF(wb As Workbook, fs$, bol1 As Boolean, bol2 As Boolean)
' dummy function for test purposes
Create_PDF = "ErnieEls.pdf"
End Function


Function Mail_PDF_Outlook(FileNamePDF$, ByVal StrTo$, StrSubject$, StrBody$, Send As Boolean)
Dim OutApp As Object, OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing:      Set OutApp = Nothing
End Function

 

[Johnboy]

Worf,

Thanks for the response. Below is the function to create PDF. The only issue now is with the code you provided creates an email for each individuals listed in column Q, currently there is 58 emails. Is it possible to have one email with all 58 in the To: box.

Thanks
Johnboy

Function Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant
If Dir(Environ(“commonprogramfiles”) & "\Microsoft Shared\OFFICE” _
& Format(Val(Application.Version), “00”) & "\EXP_PDF.DLL”) <> "" Then
If FixedFilePathName = "" Then
FileFormatstr = “PDF Files (*.pdf), *.pdf”
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:=“Create PDF”)
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
If Dir(Fname) <> "" Then Create_PDF = Fname
End If
End Function

 

[Worf]

Hello John

Thanks for the function. Please test this new version; note that I changed the file path but that can be easily altered back.

Sub Send_Slides()
Dim FileName$, i%, ts$, ws As Worksheet


Set ws = ThisWorkbook.Worksheets("recap")


FileName = Create_PDF(ActiveWorkbook, ThisWorkbook.Path, True, False)
ts = ""
' create list of email addresses
For i = 1 To ws.Range("q" & Rows.Count).End(xlUp).Row
    ts = ts & ws.Cells(1, 17).Offset(i - 1, 0).Value & ";"
Next


If FileName <> "" Then
                           
        Mail_PDF_Outlook FileName, ts, "Daily Slides " + _
        ws.Range("j1"), "ALCON, """ & vbNewLine & vbNewLine & "Daily Slides for " + _
        ws.Range("j1") + " attached." & vbNewLine & vbNewLine & "", False
    
Else


    MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
    "Microsoft Add-in is not installed" & vbNewLine & _
    "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
    "The path to Save the file in arg 2 is not correct" & vbNewLine & _
    "You didn’t want to overwrite the existing PDF if it exist", vbCritical
        
End If
End Sub

 

[Johnboy]

Wor,
Works as advertised.
Really appreciate the help.

Johnboy

 

[Worf]

You are welcome and thanks for the feedback