Steiner
08-25-2004, 08:01 AM
Hi,
Dreami wanted to have some macro for "her" KB that could mail a word document not just using Outlook but other programs as well.
By digging in some code, I found that one using MAPI. But I could only test it using Outlook and MSMail, so if anyone could try it out on other clients / improve the code, feel free to do so here.
Option Explicit
Private Type MAPIMessage 'Mail-Object
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Flags As Long
RecipCount As Long
FileCount As Long
End Type
Private Type MapiRecip 'Recipient
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type
Private Type MapiFile 'File to include
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type
' MAPI Return Codes
Private Const SUCCESS_SUCCESS = 0
Private Const MAPI_USER_ABORT = 1
Private Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Private Const MAPI_E_FAILURE = 2
Private Const MAPI_E_LOGIN_FAILURE = 3
Private Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Private Const MAPI_E_DISK_FULL = 4
Private Const MAPI_E_INSUFFICIENT_MEMORY = 5
Private Const MAPI_E_BLK_TOO_SMALL = 6
Private Const MAPI_E_TOO_MANY_SESSIONS = 8
Private Const MAPI_E_TOO_MANY_FILES = 9
Private Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Private Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Private Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Private Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Private Const MAPI_E_UNKNOWN_RECIPIENT = 14
Private Const MAPI_E_BAD_RECIPTYPE = 15
Private Const MAPI_E_NO_MESSAGES = 16
Private Const MAPI_E_INVALID_MESSAGE = 17
Private Const MAPI_E_TEXT_TOO_LARGE = 18
Private Const MAPI_E_INVALID_SESSION = 19
Private Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Private Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Private Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Private Const MAPI_E_MESSAGE_IN_USE = 22
Private Const MAPI_E_NETWORK_FAILURE = 23
Private Const MAPI_E_INVALID_EDITFIELDS = 24
Private Const MAPI_E_INVALID_RECIPS = 25
Private Const MAPI_E_NOT_SUPPORTED = 26
Private Const MAPI_ORIG = 0 'Empf?nger-Flags
Private Const MAPI_TO = 1
Private Const MAPI_CC = 2
Private Const MAPI_BCC = 3
Private Const MAPI_LOGON_UI = &H1 'Logon Flags
Private Const MAPI_NEW_SESSION = &H2
Private Const MAPI_FORCE_DOWNLOAD = &H1000
Private Const MAPI_LOGOFF_SHARED = &H1 'Logoff Flags
Private Const MAPI_LOGOFF_UI = &H2
Private Const MAPI_DIALOG = &H8 'Send-Mail-Flags
Private Const MAPI_NODIALOG = 0
Private Const MAPI_OLE = &H1 'Anhang-Flags
Private Const MAPI_OLE_STATIC = &H2
Private Const MAPI_UNREAD = &H1 'Mail-Flags
Private Const MAPI_RECEIPT_REQUESTED = &H2
Private Const MAPI_SENT = &H4
Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam&, ByVal User$, ByVal Password$, ByVal Flags&, ByVal Reserved&, Session&) As Long
Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session&, ByVal UIParam&, ByVal Flags&, ByVal Reserved&) As Long
Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" (ByVal Session&, ByVal UIParam&, Message As MAPIMessage, Recipient() As MapiRecip, File() As MapiFile, ByVal Flags&, ByVal Reserved&) As Long
Private Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam&, ByVal DelimStr$, ByVal FilePaths$, ByVal FileNames$, ByVal Reserved&) As Long
Function SendIt(sRecip$, sTitle$, sText$, sFile$) As Boolean
Dim strTemp As String
Dim strError As String
Dim lngIndex As Long
Dim mRecip(0) As MapiRecip, mFile(0) As MapiFile, mMail As MAPIMessage, lSess&, lRet&, lSess2&
On Error GoTo ErrorHandler
SendIt = False
sText = sText & " "
' Setup Recipient
With mRecip(0)
.Name = sRecip
.RecipClass = MAPI_TO
End With
' Setup Doc
With mFile(0)
.FileName = sFile
.PathName = sFile
.Position = Len(sText) - 1
.FileType = ""
.Reserved = 0
End With
' Create Mail
With mMail
.Subject = sTitle
.NoteText = sText
.Flags = 0
.FileCount = 1
.RecipCount = 1
.Reserved = 0
.DateReceived = ""
.MessageType = ""
End With
' Send it
lRet = MAPILogon(0, "", "", MAPI_LOGON_UI, 0, lSess)
If lRet <> SUCCESS_SUCCESS Then
strError = "Error logging into messaging software. (" & CStr(lRet) & ")"
GoTo ErrorHandler
End If
lRet = MAPISendMail(lSess, 0, mMail, mRecip, mFile, MAPI_NODIALOG, 0)
If lRet <> SUCCESS_SUCCESS And lRet <> MAPI_USER_ABORT Then
If lRet = 14 Then
strError = "Check Address!"
Else
strError = "Error:" & CStr(lRet)
End If
GoTo ErrorHandler
End If
lRet = MAPILogoff(lSess, 0, 0, 0)
SendIt = True
Exit Function
ErrorHandler:
If strError = "" Then strError = Err.Description
Call MsgBox(strError, vbExclamation, "Error Sending")
End Function
Sub SendActiveDoc()
ActiveDocument.Save
SendIt "mailrecip@somewhere.else", "This is a test", "Some text in the mail", ActiveDocument.FullName
End Sub
Thanks,
Daniel
Dreami wanted to have some macro for "her" KB that could mail a word document not just using Outlook but other programs as well.
By digging in some code, I found that one using MAPI. But I could only test it using Outlook and MSMail, so if anyone could try it out on other clients / improve the code, feel free to do so here.
Option Explicit
Private Type MAPIMessage 'Mail-Object
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Flags As Long
RecipCount As Long
FileCount As Long
End Type
Private Type MapiRecip 'Recipient
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type
Private Type MapiFile 'File to include
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type
' MAPI Return Codes
Private Const SUCCESS_SUCCESS = 0
Private Const MAPI_USER_ABORT = 1
Private Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Private Const MAPI_E_FAILURE = 2
Private Const MAPI_E_LOGIN_FAILURE = 3
Private Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Private Const MAPI_E_DISK_FULL = 4
Private Const MAPI_E_INSUFFICIENT_MEMORY = 5
Private Const MAPI_E_BLK_TOO_SMALL = 6
Private Const MAPI_E_TOO_MANY_SESSIONS = 8
Private Const MAPI_E_TOO_MANY_FILES = 9
Private Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Private Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Private Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Private Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Private Const MAPI_E_UNKNOWN_RECIPIENT = 14
Private Const MAPI_E_BAD_RECIPTYPE = 15
Private Const MAPI_E_NO_MESSAGES = 16
Private Const MAPI_E_INVALID_MESSAGE = 17
Private Const MAPI_E_TEXT_TOO_LARGE = 18
Private Const MAPI_E_INVALID_SESSION = 19
Private Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Private Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Private Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Private Const MAPI_E_MESSAGE_IN_USE = 22
Private Const MAPI_E_NETWORK_FAILURE = 23
Private Const MAPI_E_INVALID_EDITFIELDS = 24
Private Const MAPI_E_INVALID_RECIPS = 25
Private Const MAPI_E_NOT_SUPPORTED = 26
Private Const MAPI_ORIG = 0 'Empf?nger-Flags
Private Const MAPI_TO = 1
Private Const MAPI_CC = 2
Private Const MAPI_BCC = 3
Private Const MAPI_LOGON_UI = &H1 'Logon Flags
Private Const MAPI_NEW_SESSION = &H2
Private Const MAPI_FORCE_DOWNLOAD = &H1000
Private Const MAPI_LOGOFF_SHARED = &H1 'Logoff Flags
Private Const MAPI_LOGOFF_UI = &H2
Private Const MAPI_DIALOG = &H8 'Send-Mail-Flags
Private Const MAPI_NODIALOG = 0
Private Const MAPI_OLE = &H1 'Anhang-Flags
Private Const MAPI_OLE_STATIC = &H2
Private Const MAPI_UNREAD = &H1 'Mail-Flags
Private Const MAPI_RECEIPT_REQUESTED = &H2
Private Const MAPI_SENT = &H4
Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam&, ByVal User$, ByVal Password$, ByVal Flags&, ByVal Reserved&, Session&) As Long
Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session&, ByVal UIParam&, ByVal Flags&, ByVal Reserved&) As Long
Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" (ByVal Session&, ByVal UIParam&, Message As MAPIMessage, Recipient() As MapiRecip, File() As MapiFile, ByVal Flags&, ByVal Reserved&) As Long
Private Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam&, ByVal DelimStr$, ByVal FilePaths$, ByVal FileNames$, ByVal Reserved&) As Long
Function SendIt(sRecip$, sTitle$, sText$, sFile$) As Boolean
Dim strTemp As String
Dim strError As String
Dim lngIndex As Long
Dim mRecip(0) As MapiRecip, mFile(0) As MapiFile, mMail As MAPIMessage, lSess&, lRet&, lSess2&
On Error GoTo ErrorHandler
SendIt = False
sText = sText & " "
' Setup Recipient
With mRecip(0)
.Name = sRecip
.RecipClass = MAPI_TO
End With
' Setup Doc
With mFile(0)
.FileName = sFile
.PathName = sFile
.Position = Len(sText) - 1
.FileType = ""
.Reserved = 0
End With
' Create Mail
With mMail
.Subject = sTitle
.NoteText = sText
.Flags = 0
.FileCount = 1
.RecipCount = 1
.Reserved = 0
.DateReceived = ""
.MessageType = ""
End With
' Send it
lRet = MAPILogon(0, "", "", MAPI_LOGON_UI, 0, lSess)
If lRet <> SUCCESS_SUCCESS Then
strError = "Error logging into messaging software. (" & CStr(lRet) & ")"
GoTo ErrorHandler
End If
lRet = MAPISendMail(lSess, 0, mMail, mRecip, mFile, MAPI_NODIALOG, 0)
If lRet <> SUCCESS_SUCCESS And lRet <> MAPI_USER_ABORT Then
If lRet = 14 Then
strError = "Check Address!"
Else
strError = "Error:" & CStr(lRet)
End If
GoTo ErrorHandler
End If
lRet = MAPILogoff(lSess, 0, 0, 0)
SendIt = True
Exit Function
ErrorHandler:
If strError = "" Then strError = Err.Description
Call MsgBox(strError, vbExclamation, "Error Sending")
End Function
Sub SendActiveDoc()
ActiveDocument.Save
SendIt "mailrecip@somewhere.else", "This is a test", "Some text in the mail", ActiveDocument.FullName
End Sub
Thanks,
Daniel