Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Kelley Lawson   on Jan 27 In MS Office Category.

  
Question Answered By: Adalhelm Fischer   on Jan 27

Unfortunately though it only seems to send  one
attachment to one recipient. I'm OK with that bit. The challenge
seems to be sending multiple  attachments to multiple recipients.

As someone else suggested, I'm adding some code.....

Sub SendMessage()
Dim rc As Long
Dim msg As MapiMessage
Dim recip(1) As MapiRecip
Dim attach(1) As MapiFile

'recip(1).Name = StrConv("pjs", vbFromUnicode)
recip(1).Address = StrConv("smtp:a.name@...", vbFromUnicode)
recip(1).RecipClass = 1
attach(1).Position = -1
attach(1).PathName = StrConv("c:\testfile.txt", vbFromUnicode)
msg.Subject = "test subject"
msg.NoteText = "this one should have an attachment"
msg.RecipCount = 1
msg.Recipients = VarPtr(recip(1))
msg.FileCount = 1
msg.Files = VarPtr(attach(1))

rc = MAPISendMail(0, 0, msg, 0, 0)

End Sub

This works  fine (as long as you've already defined the MAPI function
MAPISendMail and got hold of an appropriate dll file). The fun
starts when you want to send multiple attachments to multiple
recipients. As you can see the attachments and recipients  are
arrays, so it 'should' be straightforward. The difficulty seems to
be that, in the code  I've seen so far, you have to use either the
VarPtr or VarPtrArray function to tell the MAPISendMail the address
of the first element in the array. The following routine uses this
idea.

Sub SendMailWithOE(ByVal strSubject As String, _
ByVal strMessage As String, _
ByRef aRecips As Variant, _
Optional ByVal vfiles As String)

Dim aFiles() As String
Dim recips() As MAPIRecip
Dim filepaths() As MAPIFile
Dim attachments() As MAPIFile
Dim message As MAPIMessage
Dim z As Long
ReDim recips(LBound(aRecips) To UBound(aRecips))
ReDim attachments(LBound(aRecips) To UBound(aRecips))

'This bit  finds
For z = LBound(aRecips) To UBound(aRecips)
With recips(z)
.RecipClass = 1
If InStr(aRecips(z), "@") <> 0 Then
.Address = StrConv(aRecips(z), vbFromUnicode)
Else
.Name = StrConv(aRecips(z), vbFromUnicode)
End If
End With
Next z

'This next bit does the same as above but for the attachments -
I've got from another routine
aFiles = Split(vfiles, ",")
ReDim filepaths(LBound(aFiles) To UBound(aFiles))
For z = LBound(aFiles) To UBound(aFiles)
With filepaths(z)
.Position = -1
.PathName = StrConv(aFiles(z), vbFromUnicode)
End With
Next z

With message
.NoteText = strMessage
.Subject = strSubject
.RecipCount = UBound(recips) + 1
.Recipients = VarPtr(recips(LBound(recips)))
.FileCount = UBound(filepaths) - LBound(filepaths) + 1 'new
.Files = VarPtr(filepaths(LBound(filepaths))) 'new

End With
MAPISendMail 0, 0, message, 0, 0

End Sub

This works for the recipients. I took the same idea (and some code
from elsewhere) to replicate it for attachments, but the line

.Files = VarPtr(filepaths(LBound(filepaths)))

makes Excel crash. Presumably its not supplying the right address,
but I've no idea why.....

Share: 

 

This Question has 5 more answer(s). View Complete Question Thread

 
Didn't find what you were looking for? Find more on Controlling Outlook Express with VBA/Excel Or get search suggestion and latest updates.


Tagged: