By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,480 Members | 2,766 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,480 IT Pros & Developers. It's quick & easy.

Sending Email with Attachment in Access97 using Outlook Express

P: n/a
Hi All,

Several weeks ago i started a topic with the same subject, however the
solutions provided was for using MS Outlook (fullblown version). I
finally found something that works directly with Outlook Express,
however i dont know how to attach any document using the below code. If
anybody knows how to do it, please help me to modify the below code and
provide some sample on how to use it.

Thanks in advance.
Hans

'--- BEGIN CODE ----

Option Explicit

Type MAPIRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type

Type MAPIFileTag
Reserved As Long
TagLength As Long
Tag() As Byte
EncodingLength As Long
Encoding() As Byte
End Type
Type MAPIFile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type

Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Originator As Long
Flags As Long
RecipCount As Long
Recipients As Long
Files As Long
FileCount As Long
End Type

Declare Function MAPISendMail _
Lib "c:\program files\outlook express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
message As MAPIMessage, _
ByVal Flags As Long, _
ByVal Reserved As Long) As Long
Private Const MAPI_E_NO_LIBRARY = 999
Private Const MAPI_E_INVALID_PARAMETER = 998

Private Const MAPI_ORIG = 0
Private Const MAPI_TO = 1
Private Const MAPI_CC = 2
Private Const MAPI_BCC = 3

Private Const MAPI_UNREAD = 1
Private Const MAPI_RECEIPT_REQUESTED = 2
Private Const MAPI_SENT = 4

Private Const MAPI_LOGON_UI = &H1
Private Const MAPI_NEW_SESSION = &H2
Private Const MAPI_DIALOG = &H8
Private Const MAPI_UNREAD_ONLY = &H20
Private Const MAPI_ENVELOPE_ONLY = &H40
Private Const MAPI_PEEK = &H80
Private Const MAPI_GUARANTEE_FIFO = &H100
Private Const MAPI_BODY_AS_FILE = &H200
Private Const MAPI_AB_NOMODIFY = &H400
Private Const MAPI_SUPPRESS_ATTAch = &H800
Private Const MAPI_FORCE_DOWNLOAD = &H1000

Private Const MAPI_OLE = &H1
Private Const MAPI_OLE_STATIC = &H2

Dim mAf() As MAPIFile
Dim mAr() As MAPIRecip
Dim lAr As Long
Dim lAf As Long
Dim mM As MAPIMessage
Dim aErrors(0 To 26) As String

Private Sub Class_Initialize()
aErrors(0) = "Success"
aErrors(1) = "User Abort"
aErrors(2) = "Failure"
aErrors(3) = "LogIn Failure"
aErrors(4) = "Disk Full"
aErrors(5) = "Insufficient Memory"
aErrors(6) = "Block Too Small"
aErrors(8) = "Too Many Sessions"
aErrors(9) = "Too Many Files"
aErrors(10) = "Too Many Recipients"
aErrors(11) = "Attachment No Found"
aErrors(12) = "Attachment Open Failure"
aErrors(13) = "Attachment Write Failure"
aErrors(14) = "Unknown Recipient"
aErrors(15) = "Bad Recipient"
aErrors(16) = "No Messages"
aErrors(17) = "Invalid Message"
aErrors(18) = "Text Too Large"
aErrors(19) = "Invalid Session"
aErrors(20) = "Type Not Suppported"
aErrors(21) = "Ambiguous Recipient"
aErrors(22) = "Message in Use"
aErrors(23) = "Network Failure"
aErrors(24) = "Invalid Edit Fields"
aErrors(25) = "Invalid Recipient"
aErrors(26) = "Not Supported"
End Sub

Public Sub BCCAddressAdd(ByVal strAddress As String)
RecipientAdd MAPI_BCC, , strAddress
End Sub

Public Sub BCCNameAdd(ByVal strName As String)
RecipientAdd MAPI_BCC, strName
End Sub

Public Sub CCAddressAdd(ByVal strAddress As String)
RecipientAdd MAPI_CC, , strAddress
End Sub

Public Sub CCNameAdd(ByVal strName As String)
RecipientAdd MAPI_CC, strName
End Sub

Public Sub MessageIs(ByVal strNoteText As String)
mM.NoteText = strNoteText
End Sub

Public Sub SubjectIs(ByVal strSubject As String)
mM.Subject = strSubject
End Sub

Public Sub ToAddressAdd(ByVal strAddress As String)
RecipientAdd MAPI_TO, , strAddress
End Sub

Public Sub ToNameAdd(ByVal strName As String)
RecipientAdd MAPI_TO, strName
End Sub

Public Sub FileAdd(ByVal strPathName As String)
Dim f As MAPIFile
With f
.PathName = StrConv(strPathName, vbFromUnicode)
End With
ReDim Preserve mAf(lAf)
mAf(lAf) = f
lAf = lAf + 1
End Sub

Public Sub Send()
Dim r As Long
With mM
If lAf 0 Then
.FileCount = lAf
.Files = VarPtr(mAf(0))
End If
If lAr 0 Then
.RecipCount = lAr
.Recipients = VarPtr(mAr(0))
r = MAPISendMail(0, 0, mM, 0, 0)
If r <0 Then MsgBox aErrors(r)
End If
End With
End Sub

Private Sub RecipientAdd(ByVal lngType As Long, _
Optional ByVal strName As String, Optional ByVal strAddress As
String)
Dim r As MAPIRecip
r.RecipClass = lngType
If strName <"" Then r.Name = StrConv(strName, vbFromUnicode)
If strAddress <"" Then r.Address = StrConv(strAddress,
vbFromUnicode)
ReDim Preserve mAr(lAr)
mAr(lAr) = r
lAr = lAr + 1
End Sub
Sub SendMailWithOE(ByVal strSubject As String, ByVal strMessage As
String, ByRef aRecips As Variant, FileName As String)
Dim recips() As MAPIRecip
Dim message As MAPIMessage
Dim z As Long
ReDim recips(LBound(aRecips) To UBound(aRecips))
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

FileAdd (FileName)
With message
.NoteText = strMessage
.Subject = strSubject
.Files = 1
.RecipCount = UBound(recips) - LBound(aRecips) + 1
.Recipients = VarPtr(recips(LBound(recips)))
End With
MAPISendMail 0, 0, message, 0, 0
End Sub

Sub TestSendMailwithOE()
Dim aRecips(0 To 0) As String
aRecips(0) = "smtp:te**@hotmail.com"
SendMailWithOE "Send Mail Through OE", "Sure, you can, Tom!",
aRecips, "c:\test.pdf"
End Sub
'--- END CODE ----

Sep 8 '06 #1
Share this Question
Share on Google+
1 Reply


P: n/a
ha************@gmail.com wrote:
Several weeks ago i started a topic with the same subject, however the
solutions provided was for using MS Outlook (fullblown version). I
finally found something that works directly with Outlook Express,
however i dont know how to attach any document using the below code. If
anybody knows how to do it, please help me to modify the below code and
provide some sample on how to use it.
I strongly urge you to discard the notion of using OE to send e-mail
from Access. It is clumsy, slow, may pop up a warning and the code you
posted could generously be described as a cludge, perhaps even a hack.
It was written in response to a challenge and never intended for
practical use. (There are other original but later versions that are
purported to be for practical use.)

There is at least one much better way. Search this NewsGroup for "CDO"
and you will find various examples. CDO is strong, fast and silent.

If you must use OE, try the code below.

Private Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As Long
End Type

Private Type MAPIFileDesc
Reserved As Long
flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type

Private Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Originator As Long
flags As Long
RecipCount As Long
Recipients As Long
FileCount As Long
Files As Long
End Type

Declare Function MAPISendMail _
Lib "c:\program files\outlook express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long

Public Sub SendMailWithOE(ByVal vSubject As String, _
ByVal vMessage As String, _
ByRef vRecipients As String, _
Optional ByVal vFiles As String)

Dim aFiles() As String
Dim aRecips() As String

Dim FilePaths() As MAPIFileDesc
Dim Recips() As MapiRecip
Dim Message As MAPIMessage

Dim z As Long

If Len(vFiles) 0 Then
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
End If

aRecips = Split(vRecipients, ",")
ReDim Recips(LBound(aRecips) To UBound(aRecips))
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

With Message
If Len(vFiles) 0 Then
.FileCount = UBound(FilePaths) - LBound(FilePaths) + 1
.Files = VarPtr(FilePaths(LBound(FilePaths)))
End If
.NoteText = vMessage
.RecipCount = UBound(Recips) - LBound(Recips) + 1
.Recipients = VarPtr(Recips(LBound(Recips)))
.Subject = vSubject
End With
MAPISendMail 0, 0, Message, 0, 0
End Sub

Private Sub Test_SendMailWithOE()
Dim aFiles() As Variant
Dim aRecips() As String
Dim Files As String
Dim Message As String
Dim Recipients As String
Dim Subject As String

' not required
Files = "C:\twacker.log"
Files = Files & "," & "C:\readme.txt"

' required
Recipients = "So*****@Some.Domain"

' not required
Recipients = Recipients & "," & "So*********@SomeOther.Domain"

Message = "Let me know if you get this, please."

Subject = "Test"

SendMailWithOE Subject, Message, Recipients, Files

End Sub

Public Function SplitB(ByVal SplitString As String, ByVal Delimiter As
String) As Variant
Dim Position As Long
Dim aSplit() As Variant
Dim Dimension As Long
Position = InStr(SplitString, Delimiter)
Do While Position <0
ReDim Preserve aSplit(Dimension)
aSplit(UBound(aSplit)) = Trim(Left(SplitString, Position - 1))
SplitString = Mid$(SplitString, Position + 1)
Dimension = Dimension + 1
Position = InStr(SplitString, Delimiter)
Loop
ReDim Preserve aSplit(Dimension)
aSplit(Dimension) = Trim(SplitString)
SplitB = aSplit
End Function

Sep 8 '06 #2

This discussion thread is closed

Replies have been disabled for this discussion.