Email attachments

[Jackie L]

I am using Bill Mosca's function for Outlook_SendEmail but I am having
difficulty getting multiple attachments to work.

I am creating a .pdf file of a report and then concatenating unlimited files
based on file location string in a field.

My issue is this, when I send just the .pdf as an attachment, it works, when
I send the file strings as text (i.e. "c:\File1.xls",
"c:\File2.xls","c:\File3.xls") typed into the code, it works.

If I declare a string and define it as the file locations, it does not work.
I believe the issue is with the quotation marks but I cannot come up with a
combination that the function will accept. I have also declared a string for
the quotation marks so that there is no problem with double or single
quotations.

I have not worked with arrays but I could populate one with the file
locations if need be.

The following code puts a quotation mark at the beginning and ending of the
strAttachment but I have done it in all combinations. If there are no
attachments besides the PO itself, the code runs.

Dim strMsg As String
Dim BlockCount As Integer
Dim Counter As Integer
Dim RptName As String
Dim SnapshotName As String
Dim OutputPDFName As String
Dim blRet As Boolean
Dim ShowSaveFileDialog As Boolean
Dim StartPDFViewer As Boolean
Dim strSubject As String
Dim strAddress As String
Dim strMessage As String
Dim strAttachments As String
Dim strPOFiles As String
Dim strQuotation As String

strQuotation = Chr$(34)


If Forms!frmPurchaseOrder!Type = "Vendor" Then
RptName = "rptPurchaseOrderVendor"
Else
RptName = "rptPurchaseOrder"
End If

DoCmd.SetWarnings False
DoCmd.OpenQuery "qryPOFiles"
DoCmd.OpenForm "frmPOFiles"
DoCmd.SetWarnings True
strPOFiles = Nz(DMax("Attachments", "tblPOFilesTemp"))

ShowSaveFileDialog = False
StartPDFViewer = False

strMsg = "You are about to send PO to the email address listed."
strSubject = "Purchase Order"

If MsgBox(strMsg, vbOKCancel, "Email PO") = vbOK Then
strAddress = Forms!frmPurchaseOrder!POEmail
strMessage = Me.EmailNote & Chr(13) & Chr(13) & Me.EmpName
OutputPDFName = "S:\Work Order Database\PO Sent\" & Forms! _
frmPurchaseOrder!PONumber & ".pdf"
blRet = ConvertReportToPDF(RptName, vbNullString, _
OutputPDFName, False, True, 0, "", "", 0, 0)

'to add attachments created by frmPOFiles
If DCount("QuoteFile", "tblPOFilesTemp") > 0 Then
strAttachments = strQuotation & OutputPDFName & ", " &
strPOFiles & strQuotation
Else
strAttachments = OutputPDFName
End If
Me.FileTest = strAttachments

MsgBox Outlook_SendEmail(strSubject, strAddress, strMessage,
strAttachments)
DoCmd.SelectObject acForm, "frmPurchaseOrder", True
DoCmd.RunCommand acCmdFormView
MsgBox "Purchase Order sent."
Forms!frmPurchaseOrder!EmailSent = Now()
DoCmd.Close acForm, "frmPurchaseOrderEmail"
Else
Exit Sub
End If

I apologize if this is confusing, I just need what the snytax needs to be
for the attachments.

Thanks,
Jackie

 

[Arvin Meyer [MVP]]

Sorry, I don't see anything in this code to actually send an email. Have a
look at my code at:

http://www.datastrat.com/Code/OutlookEmail.txt

The line of code to add an attachment is:

.Attachments.Add "C:\Test.htm"
.Attachments.Add "c:\Path\to\the\next\file.txt"
.Attachments.Add "c:\Path\to\the\third\file.pdf"

and you add as many as you want.

 

[Jackie L]

Arvin,

I did see your function out there also but I come up with the same issue
that the attached files are different for every time sent and in varying
numbers.

Here is the code for sending the email

Function Outlook_SendEmail(ByVal strSubject As String, _
ByVal strTo As String, _
ByVal strMsg As String, _
ParamArray AttachmentList() As Variant) As Boolean

'Purpose : Automatically send email to an Outlook mailbox.
'DateTime : 11/30/2003 12:12
'Author : Bill Mosca
Dim objOLApp As Outlook.Application
Dim outItem As Outlook.MailItem
Dim outFolder As MAPIFolder
Dim DestFolder As MAPIFolder
Dim outNameSpace As NameSpace
Dim lngAttachment As Long

On Error GoTo ErrorHandler

Set objOLApp = CreateObject("Outlook.Application")
Set outNameSpace = objOLApp.GetNamespace("MAPI")
Set outFolder = outNameSpace.GetDefaultFolder(6) 'olFolderInbox=6
Set outItem = objOLApp.CreateItem(0) 'olMailItem=0
outItem.Body = strMsg
outItem.Subject = strSubject
outItem.To = strTo

With outItem.Attachments
For lngAttachment = LBound(AttachmentList) To UBound(AttachmentList)
.Add AttachmentList(lngAttachment)
Next lngAttachment
End With

outItem.Send
Outlook_SendEmail = True

ExitProcedure:
On Error Resume Next
Set outItem = Nothing
Set outFolder = Nothing
Set outNameSpace = Nothing
Set objOLApp = Nothing
Exit Function

ErrorHandler:
Select Case Err.Number
Case 287
'User stopped Outlook from sending
MsgBox "Email cancelled by user.", vbInformation
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") " _
& "in procedure Outlook_SendEmail of VBA Document
mod_Utilities"
End Select


Resume ExitProcedure



Even in your example, how would I take either a group of records with fields
containing file locations or a string of the file locations and apply it to
the attachments?

Thanks for your help

 

[Arvin Meyer [MVP]]

Even in your example, how would I take either a group of records with
fields
containing file locations or a string of the file locations and apply it
to
the attachments?

If it's just file locations, it is probably easier to just write them to the
body of the email.

outItem.Body = Me.txtFilePath

for a single file path located in your form. Or you can build a recordset
and write the output to the body. If you want to use attachments you need to
build a file and write whatever you want to that file. Here's a snippet of
code I used to build a file from a recordset:

strPOPath = "C:\FolderName\PO-" & Me.lstLots.Column(1) & "-" &
Me.lstLots.Column(2) & ".txt"

qdef.Parameters(0) =
[Forms]![frmLotModel]![subLotModel].[Form]![txtPONumber]
Set rst = qdef.OpenRecordset

Open strPOPath For Append As #1

' Reverse PO Header
Print #1, "C" & "," & rst!PONumber & "," & "2" & "," & "Vendor" &
"," & rst!ContractorID & _
"," & rst!ReversedDate

' Reverse PO Detail
rst.MoveFirst
Do Until rst.EOF
Print #1, "CI" & "," & rst!PONumber & ",," & rst!CCDescr &
",,,," & _
rst!Job & ",," & _
Format(rst!CostCode, "0.000") & "," & "S" & ",,,,,," &
rst!RevCost
rst.MoveNext
Loop