Can I combine Emailing Methods? 1

[GPM4663]

Hi everyone,
Normally if i was emailing a report I would use the following code to send a snapshot of it:

------------------------------------------------
DoCmd.SendObject acSendReport, "rptPurchaseOrder", acFormatSNP, strTo, strCC, , strSubject, strMessage
-------------------------------------------------

However, this time around i want to send the email and ask for a read receipt as well. Normally if i was doing this I would use the code:

---------------------------------------------
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
.To = strTo
'.CC = msgCC
.Subject = strSubject
.Body = strMessage
.ReadReceiptRequested = True
.Importance = olImportanceHigh
.Display
End With
---------------------------------------------

But I've never used the above code and tried to attach a report to it.

So my question is, can I use the second piece of code and attach a report to the email as a snapshot?

Thanks in advance for any help you can give me

GPM

 

[jrbarnett]

First, create the files on disk:

docmd.OutputTo acOutputReport, "ReportName", acFormatSNP, "c:\filename.snp"

The last parameter is the name of the file to generate. If you leave this out, Outlook will prompt for a location.

Then before the .Display line, use:

.Attachments.Add "c:\filename.snp"

For more information on attaching a file programmatically to an email, see

http://www.dicks-clicks.com/excel/olSending.htm

John

 

[pwnawannab]

I actually logged in to ask a similar question about dealing with multiple outlook attachments. I'd like to allow user to select any number of attachments.
I basically collect all paths in a string (see below) and then I would use the routine similar to what you have linked. But I am having trouble with a loop logic to create multiple attachments. Any help would be appreciated.

Private Sub cmdAttach_Click()
Dim strSearchPath As String
Dim i As Variant
Dim strEntry As Variant
Dim strEntryConc As String
Dim fd As FileDialog


Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.title = "Please select a document..."
.Filters.Clear
.Filters.Add "All Files", "*.*", 1
.InitialFileName = strSearchPath


If .Show = True Then
For Each i In .SelectedItems
strEntry = i
If strEntryConc <> "" Then
strEntryConc = strEntryConc & ";" & i
Me.Attachment.Value = strEntryConc
Else
Me.Attachment.Value = strEntry
strEntryConc = Me.Attachment.Value
End If
Next
End If
End With
Set fd = Nothing
End Sub

 

[pwnawannab]

Ok, here is what I came up with after a grueling search on the net. I found pretty standard way to create an email with attachment and added a loop to it.

Sub SendMessage(MsgAction As String, strTo As String, strSubject As String, strMessage As String, Optional AttachmentPath As String, Optional ByVal blnImportant As Boolean)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim intCnt As Integer
Dim i As Integer
Dim sParts() As String


' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(strTo)
objOutlookRecip.Type = olTo

' Set the Subject, Body, and Importance of the message.
.Subject = strSubject
.Body = strMessage & vbCrLf & vbCrLf
If blnImportant = True Then
.Importance = olImportanceHigh 'High importance
End If

' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
intCnt = CountCSWords(AttachmentPath)
For i = 1 To intCnt
sParts = Split(GetCSWord(AttachmentPath, i), ";")
Set objOutlookAttach = .Attachments.Add(sParts(0))
Next
End If

' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next

' Send or Save our message
If MsgAction = "Save" Then
.Display
.Save
Else
.Display
.Send
End If
End With
Set objOutlook = Nothing
End Sub


In order for loop to work my delimited attachment paths needed to be counted. I used two routines below.

Function CountCSWords(ByVal s) As Integer
'Counts the words in delimited string
Dim WC As Integer, Pos As Integer
If VarType(s) <> 8 Or Len(s) = 0 Then
CountCSWords = 0
Exit Function
End If
WC = 1
Pos = InStr(s, ";")
Do While Pos > 0
WC = WC + 1
Pos = InStr(Pos + 1, s, ";")
Loop
CountCSWords = WC
End Function

Function GetCSWord(ByVal s, Indx As Integer)
'Returns the nth word in a specific field.
Dim WC As Integer, Count As Integer
Dim SPos As Integer, EPos As Integer

WC = CountCSWords(s)
If Indx < 1 Or Indx > WC Then
GetCSWord = Null
Exit Function
End If
Count = 1
SPos = 1
For Count = 2 To Indx
SPos = InStr(SPos, s, ";") + 1
Next Count
EPos = InStr(SPos, s, ";") - 1
If EPos <= 0 Then EPos = Len(s)
GetCSWord = Trim(Mid(s, SPos, EPos - SPos + 1))
End Function

 

[GPM4663]

Dear jrBarnett,
Thanks for your post on this, you've been a great help. Enjoy the star!

GPM