473,320 Members | 1,870 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 473,320 software developers and data experts.

Sending Email with Attachment in Access97 using Outlook Express

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
1 10387
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 thread has been closed and replies have been disabled. Please start a new discussion.

Similar topics

3
by: Neil Greenough | last post by:
I currently have the following VB code in a MS Access Database which I use to send emails. Nonetheless, it opens Outlook and I would like it to send an email using Outlook Express. Could anyone...
2
by: Alexander | last post by:
To all, A tall order, but any help on any segment of this would be appreciated: I have a table that needs to be populated with information contained in an email attachment. 1. Is it...
5
by: paii, Ron | last post by:
How do I setup a email with attachment for preview but require the user to push the SEND button in Outlook. I have the following function but it sends the email without the sender ever seeing it. ...
2
by: Steve | last post by:
How do you programatically save files that are attached to an email to a specified folder? It could be one file or multiple files attached to the email. Can it be done if Outlook Express is being...
3
by: Prakash Wadhwani | last post by:
Hi !! I have been browsing around but have not been able to find a simple, lucid solution ... or maybe I'm just too confused. I know this has been asked before by many ... but pls bear with me. ...
4
by: Robert McNally | last post by:
Hello, I'm currently learning c# and have been trying to write a simple program with sockets. The problem is i'm trying to send an email with an attachment, (which is the program itself) by...
5
by: J-P-W | last post by:
I have some code, from this group (many thanks) that sends an attachment to an email. The following: Dim objNewMail As Outlook.MailItem Dim golApp As...
5
by: handokowidjaja | last post by:
Hi All, I'm trying to automate sending an email with an attachment in our environment (access 97) using Outlook Express ( we dont have MS outlook or other fancy stuff). Does anybody knows how to...
2
by: Hanika | last post by:
Going on 3 days and I am wodnering if I am just not looking in the right place. If anyone nows how to do this please please help me. I am developing a Windows form application using VB.NET 2005....
7
by: Paridevi | last post by:
Hai , i want to send email in .Net Using OutLook Express,My Project is Web Application using vb.Net 2003 with SQL Server 2000.I have searched a lot in Google, but ican't get any...
0
by: DolphinDB | last post by:
Tired of spending countless mintues downsampling your data? Look no further! In this article, you’ll learn how to efficiently downsample 6.48 billion high-frequency records to 61 million...
0
isladogs
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM). In this month's session, we are pleased to welcome back...
0
by: Vimpel783 | last post by:
Hello! Guys, I found this code on the Internet, but I need to modify it a little. It works well, the problem is this: Data is sent from only one cell, in this case B5, but it is necessary that data...
0
by: jfyes | last post by:
As a hardware engineer, after seeing that CEIWEI recently released a new tool for Modbus RTU Over TCP/UDP filtering and monitoring, I actively went to its official website to take a look. It turned...
1
by: PapaRatzi | last post by:
Hello, I am teaching myself MS Access forms design and Visual Basic. I've created a table to capture a list of Top 30 singles and forms to capture new entries. The final step is a form (unbound)...
0
by: CloudSolutions | last post by:
Introduction: For many beginners and individual users, requiring a credit card and email registration may pose a barrier when starting to use cloud servers. However, some cloud server providers now...
0
by: Defcon1945 | last post by:
I'm trying to learn Python using Pycharm but import shutil doesn't work
0
by: Shællîpôpï 09 | last post by:
If u are using a keypad phone, how do u turn on JavaScript, to access features like WhatsApp, Facebook, Instagram....
0
by: af34tf | last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.