Nathan
2012-08-24 15:19:07 UTC
It works correctly when I run it on my local machine, but once I upload it to
the server, Windows server 2008, and run it there, it errors out with the
runtime error code 2001 which seems potentially misleading. Here is the code:
Function emailReport(reportName)
Dim Email, Subject, strSQL, ObjectName, PdfName, Body As String
Dim db As Database
Dim rs As DAO.Recordset
Dim GetDBPath As String
'run clear and append query to append temp table data
'DoCmd.SetWarnings False
'DoCmd.OpenQuery "qry12tmpEmail-Clear"
'DoCmd.OpenQuery "qry12TmpEmail-Invoice01-Apd"
'DoCmd.SetWarnings True
'set folder path for attachments
GetDBPath = CurrentProject.Path & "\attachments\"
'MsgBox GetDBPath
'setup database and record set to query needed data
Set db = CurrentDb()
strSQL = "SELECT * FROM 12TmpEmail "
Set rs = db.OpenRecordset(strSQL)
'set pdfFile name
PdfName = GetDBPath & rs!PdfName
'loop through table to send an email for each record
rs.MoveFirst
'check if there is someone to email to
If IsNull(rs!EmailTo) Then
MsgBox "There is no email address set up for this account. Please setup a
salesperson email address for this customer to use the Email feature."
End
End If
'create "attachments" folder if it doesn't exist
If Len(Dir(GetDBPath, vbDirectory)) = 0 Then ' CHECK IF PATH EXISTS
MkDir (GetDBPath) ' If NOT - Make IT
End If ' End Check Folder Name
Do While Not rs.EOF
Email = rs!EmailTo
Subject = rs!Subject
ObjectName = rs!ObjectName
PdfName = GetDBPath & rs!PdfName
'check if there is body data in the temp table to be emailed
If IsNull(rs!BodyText) Then
Body = " "
Else
Body = rs!BodyText
End If
'MsgBox ObjectName & " " & PdfName
'open report
DoCmd.OpenReport reportName, acViewPreview, , , acWindowNormal
'create pdf from report
'MsgBox reportName & " " & PdfName
'if docmd.outputTo errors out, check the formatting of the file name
'to make sure it does not include any of the following characters: "/" "\
" ":" " "
'if so, change the formatting on the append query, "qry12TmpEmail-
Invoice01-Apd"
DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, PdfName, False
'close report
DoCmd.Close
'open Outlook, attach zip folder or file, send e-mail
'Dim appOutlook As Outlook.Application
Dim appOutlook As Object
'Dim MailOutLook As Outlook.MailItem
Dim MailOutLook As Object
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(olMailItem)
With MailOutLook
' .BodyFormat = olFormatRichText
.To = Email
''.cc = ""
''.bcc = ""
.Subject = Subject
.HTMLBody = Body
.Attachments.Add (PdfName)
''.DeleteAfterSubmit = True 'This would let Outlook send the note without
storing it in your sent bin
.send
End With
rs.MoveNext
Loop
MsgBox "Email was sent successfully."
End Function
Any and all help is appreciated!
Thanks in advance!