Save PDF and Email code error

[xian2]

Hi All,

I have been using this guide http://www.compasscomputing.co.uk/co...DFandEmail.htm to create a command button that automatically saves and e-mails your report and have tried to edit the code, as below (the original code is on his website) but get a load of error messages.

There are only a few bits that need editing (about 6 or 7 little bits) but I still get loads of error messages and if anyone can help, I would be really grateful.

To give you some background info, I would like the report to always be emailed to ***Address Removed by Mod***@aol.com (and no one else), the unique field of the report for the filter if that is necessary is 'TourID'. The name of the report is 'rptInvoice' and I would like the command button to be on 'frmTours'.

i am not sure if I have even gone about it the right way but any help would be greatly appreciated.

Many thanks in advance and best wishes

Edd

Private Sub Command114_Click()
Usage: SavePDFAndEmail "[e-mail]", Me.TourID
 
Function SavePDFAndEmail(EmailTo As String, UniqueIdentifier As Double)
'Add some error trapping
Dim strSource As String
 
Dim strTarget As String
Dim strFilename As String
'Save the PDF
DoCmd.OpenReport "rptInvoice", acViewNormal, , "[TourID] = " & TourID
'set values strSource = "C:\GhostPDF.pdf"
strTarget = CurrentDBDir & "Invoice" & TourID & ".pdf"
'copy it
FileCopy strSource, strTarget
 
'email it
Call CreateMail(EmailTo, "Invoice From D-Day Tours", "Invoice Attached", strTarget)
 
End Function Function CreateMail(ByRef astrRecip As Variant, _
strSubject As String, _
strMessage As String, _
Optional astrAttachments As Variant) As Boolean
'Code Found In comp.databases.ms-access
 
Dim objNewMail As Object
Dim varRecip As Variant
Dim varAttach As Variant
Dim blnResolveSuccess As Boolean
Dim golApp As Object
Dim initializeOutlook As Boolean
 
On Error GoTo CreateMail_Err
 
initializeOutlook = True
' Use the InitializeOutlook procedure to initialize global
' Application and NameSpace object variables, if necessary.
 
If golApp Is Nothing Then
If initializeOutlook = False Then
MsgBox "Unable to initialize Outlook Application or NameSpace object variables!"
Exit Function
End If
End If
 
Set golApp = CreateObject("Outlook.Application")
Set objNewMail = golApp.CreateItem(0)
 
With objNewMail
.Recipients.Add astrRecip
.Subject = strSubject
.Body = strMessage
.Attachments.Add astrAttachments
.Display
'.Send 'send it straight to the outbox if required
End With
 
CreateMail = True
 
Set golApp = Nothing
Set objNewMail = Nothing
 
CreateMail_End:
Exit Function
 
CreateMail_Err:
CreateMail = False
 
Select Case Err.Number
Case Is = 287
MsgBox "You clicked No to the Outlook security warning. " & _
"Please try again and click Yes to access e-mail" & _
"addresses to send your message. For more information," & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "
 
Case Is = -2009989111
MsgBox Err.Number & "" & Err.Description = "Reciepents Error"
 
Case Is = -1525219325
MsgBox Err.Number & " " & Err.Description = "Attachment Error"
 
Case Is = 438
MsgBox Err.Number & " " & Err.Description
 
Case Else
MsgBox Err.Number & "" & Err.Description
 
End Select
 
Resume CreateMail_End
End FunctionFunction CurrentDBDir() As String
Dim strDBPath As String
Dim strDBFile As String
 
strDBPath = CurrentDb.Name
strDBFile = Dir(strDBPath)
CurrentDBDir = Left$(strDBPath, Len(strDBPath) - Len(strDBFile))
 
End Function

[Denburt]

The following might be Copy/paste errors if not you need to change the following lines:

Private Sub Command114_Click()
Usage: SavePDFAndEmail "[e-mail]", Me.TourID
 

Should be:

Private Sub Command114_Click()
Usage: SavePDFAndEmail "[e-mail]", Me.TourID
end sub
 

And the following needs some changes:

End Function Function CreateMail(ByRef astrRecip As Variant, _
strSubject As String, _
strMessage As String, _
Optional astrAttachments As Variant) As Boolean
 

Change it to:

End Function 
Function CreateMail(ByRef astrRecip As Variant, _
strSubject As String, _
strMessage As String, _
Optional astrAttachments As Variant) As Boolean
 

If you still have any errors we need to know specifically what the error message is then we can go further. Hope this helps.