Word

EMail active document using MAPI

Ease of Use

Intermediate

Version tested with

97 

Submitted by:

Steiner

Description:

You want to send a document automatically but don't have Outlook? Maybe MAPI can do the trick. 

Discussion:

This one uses the Windows Mail-API, this means it should work for each program that Windows correctly recognizes as standard mail client. 

Code:

instructions for use

			

Option Explicit Private Type MAPIMessage 'Mail 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 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 'Recipient-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 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 As Long, _ ByVal User As String, ByVal Password As String, ByVal Flags As Long, _ ByVal Reserved As Long, Session As Long) As Long Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session As Long, _ ByVal UIParam As Long, ByVal Flags As Long, ByVal Reserved As Long) As Long Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" _ (ByVal Session As Long, ByVal UIParam As Long, Message As MAPIMessage, _ Recipient() As MapiRecip, File() As MapiFile, ByVal Flags As Long, _ ByVal Reserved As Long) As Long Private Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam As Long, _ ByVal DelimStr As String, ByVal FilePaths As String, ByVal FileNames As String, _ ByVal Reserved As Long) As Long Function SendIt(sRecip As String, sTitle As String, sText As String, sFile As String) As Boolean Dim strTemp As String Dim strError As String Dim lngIndex As Long Dim iFileCount As Integer Dim mRecip(0) As MapiRecip, mFile() As MapiFile, mMail As MAPIMessage Dim lSess As Long, lRet As Long On Error GoTo ErrorHandler SendIt = False 'Add 2 trailing spaces to the text, this will be the position where the attachment goes to sText = sText & " " 'Recipient With mRecip(0) .Name = sRecip .RecipClass = MAPI_TO End With 'File to send? If sFile <> "" Then ReDim mFile(0) With mFile(0) .FileName = sFile .PathName = sFile .Position = Len(sText) - 1 .FileType = "" .Reserved = 0 End With iFileCount = 1 End If 'Create Mail With mMail .Subject = sTitle .NoteText = sText .Flags = 0 .FileCount = iFileCount .RecipCount = 1 .Reserved = 0 .DateReceived = "" .MessageType = "" End With 'Post it 'Logon: User = "" and Password = "" 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 'Send the mail to the given recipients with the attached file without showing a dialog 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 = "Recipient not found" Else strError = "Error sending: " & 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, "MAPI-Error") End Function Sub eMailActiveDocument() Dim Doc As Document Application.ScreenUpdating = False Set Doc = ActiveDocument Doc.Save SendIt "me@here.com", "A new Document", "Hi, read this:", Doc.FullName Application.ScreenUpdating = True Set Doc = Nothing End Sub

How to use:

  1. Open your Word document.
  2. Press Alt + F11 to open VBE.
  3. Double click where is says "ThisDocument" on the project explorer.
  4. Insert-Module.
  5. Paste the code there in the window at right.
  6. Modify the code line SendIt to the recipient, subject and text you want in your mail (at the end of the code)
  7. Close VBE
  8. Save the file
 

Test the code:

  1. Run the macro SendIt by giving it the necessary parameters:
  2. SendIt "me@here.com", "A new Document", "Hi, read this:", ActiveDocument.FullName
  3. Or adjust the macro eMailActiveDocument and run it
 

Sample File:

MailDocument.zip 10.48KB 

Approved by mdmackillop


This entry has been viewed 169 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express