Sending Email Using Excel-VBA code

[ramankumar]

Can i Email a file other than an active worksheet or active work book. Like a word document in predefined directory.

 

[Joe Was]

Sub SendSheet()
'By: Joe Was, 1/11/2002
'Sends a copy of each sheet hard coded, as email.
'Note to work the PC system needs a MSMail server,
'configured with a valid user profile. Or, other
'way of interacting with the application - mail -
'server, for your system.

'Add first sheet name below!
Sheet1.Copy
Application.Dialogs(xlDialogSendMail).Show

'Add second sheet name below!
Sheet2.Copy
Application.Dialogs(xlDialogSendMail).Show
'Copy and insert additional blocks as needed.

'Close the Workbook (Forms) without saving.
'To Close the Workbook and Save it Change,
'"False" below to "True"
ActiveWorkbook.Close SaveChanges:=False
ActiveWorkbook.Close SaveChanges:=False
End Sub

Sub MailerCK()
'This checks what mailer is installed on your system.

Select Case Application.MailSystem
Case xlMAPI
MsgBox "Mail system is: Microsoft Mail."
Case xlPowerTalk
MsgBox "Mail system is: PowerTalk."
Case xlNoMailSystem
MsgBox "No mail system installed!"
End Select
End Sub

Sub MailWB()
'Mail Sheet directly to the named recipient.

ActiveWorkbook.SendMail Recipients:="Joseph Was"
End Sub


Sub LoggOnMail()
'Check if mail system is logged on.

If IsNull(Application.MailSession) Then
MsgBox "No Mail Session!" & Chr(13) & Chr(13) & "Will Logg On, Now!"
Application.MailLogon
Else
MsgBox "Active Mail Session!" & Chr(13) & Chr(13) & "Found!"
End If
End Sub

 

[DonkeyOte]

Here's another code...

You need to put this code in a separate module:

' MAPI Macro
' Macro recorded 1/2/2002 by Luke Wisbey
'

'
'**************************************************************************
'
'
'
' Visual Basic declaration for the MAPI functions.
'
' This file can be loaded into the global module.
'
'
'
'
'**************************************************************************
'

'***************************************************
' MAPI Message holds information about a message
'***************************************************

Type MAPIMessage
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


'************************************************
' MAPIRecip holds information about a message
' originator or recipient
'************************************************

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


'******************************************************
' MapiFile holds information about file attachments
'******************************************************

Type MapiFile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type


'***************************
' FUNCTION Declarations
'***************************

Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam&, ByVal User$, ByVal Password$, ByVal Flags&, ByVal Reserved&, Session&) As Long
Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session&, ByValUIParam&, ByVal Flags&, ByVal Reserved&) As Long
Declare Function BMAPIReadMail Lib "MAPI32.DLL" (lMsg&, nRecipients&, nFiles&, ByVal Session&, ByVal UIParam&, MessageID$, ByVal FLAG&, ByValReserved&) As Long
Declare Function MAPIFindNext Lib "MAPI32.DLL" Alias "BMAPIFindNext" (ByVal Session&, ByVal UIParam&, MsgType$, SeedMsgID$, ByVal FLAG&, ByValReserved&, MsgID$) As Long
Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam&, ByVal DelimStr$, ByVal FilePaths$, ByVal FileNames$, ByVal Reserved&) As Long
Declare Function MAPIDeleteMail Lib "MAPI32.DLL" (ByVal Session&, ByVal UIParam&, ByVal MsgID$, ByVal Flags&, ByVal Reserved&) As Long
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
Declare Function MAPISaveMail Lib "MAPI32.DLL" Alias "BMAPISaveMail" (ByVal Session&, ByVal UIParam&, MESSAGE As MAPIMessage, Recipient() As MapiRecip, FILE() As MapiFile, ByVal Flags&, ByVal Reserved&, MsgID$) As Long
Declare Function BMAPIAddress Lib "MAPI32.DLL" (lInfo&, ByVal Session&, ByVal UIParam&, Caption$, ByVal nEditFields&, Label$, nRecipients&, Recip() As MapiRecip, ByVal Flags&, ByVal Reserved&) As Long
Declare Function BMAPIGetAddress Lib "MAPI32.DLL" (ByVal lInfo&, ByValnRecipients&, Recipients() As MapiRecip) As Long
Declare Function MAPIDetails Lib "MAPI32.DLL" Alias "BMAPIDetails" (ByValSession&, ByVal UIParam&, Recipient As MapiRecip, ByVal Flags&, ByValReserved&) As Long
Declare Function MAPIResolveName Lib "MAPI32.DLL" Alias "BMAPIResolveName" (ByVal Session&, ByVal UIParam&, ByVal UserName$, ByVal Flags&, ByValReserved&, Recipient As MapiRecip) As Long



'**************************
' CONSTANT Declarations
'**************************
'

Global Const SUCCESS_SUCCESS = 0
Global Const MAPI_USER_ABORT = 1
Global Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Global Const MAPI_E_FAILURE = 2
Global Const MAPI_E_LOGIN_FAILURE = 3
Global Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Global Const MAPI_E_DISK_FULL = 4
Global Const MAPI_E_INSUFFICIENT_MEMORY = 5
Global Const MAPI_E_BLK_TOO_SMALL = 6
Global Const MAPI_E_TOO_MANY_SESSIONS = 8
Global Const MAPI_E_TOO_MANY_FILES = 9
Global Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Global Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Global Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Global Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Global Const MAPI_E_UNKNOWN_RECIPIENT = 14
Global Const MAPI_E_BAD_RECIPTYPE = 15
Global Const MAPI_E_NO_MESSAGES = 16
Global Const MAPI_E_INVALID_MESSAGE = 17
Global Const MAPI_E_TEXT_TOO_LARGE = 18
Global Const MAPI_E_INVALID_SESSION = 19
Global Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Global Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Global Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Global Const MAPI_E_MESSAGE_IN_USE = 22
Global Const MAPI_E_NETWORK_FAILURE = 23
Global Const MAPI_E_INVALID_EDITFIELDS = 24
Global Const MAPI_E_INVALID_RECIPS = 25
Global Const MAPI_E_NOT_SUPPORTED = 26

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


'***********************
' FLAG Declarations
'***********************

'* MAPILogon() flags *

Global Const MAPI_LOGON_UI = &H1
Global Const MAPI_NEW_SESSION = &H2
Global Const MAPI_FORCE_DOWNLOAD = &H1000

'* MAPILogoff() flags *

Global Const MAPI_LOGOFF_SHARED = &H1
Global Const MAPI_LOGOFF_UI = &H2

'* MAPISendMail() flags *

Global Const MAPI_DIALOG = &H8

'* MAPIFindNext() flags *

Global Const MAPI_UNREAD_ONLY = &H20
Global Const MAPI_GUARANTEE_FIFO = &H100

'* MAPIReadMail() flags *

Global Const MAPI_ENVELOPE_ONLY = &H40
Global Const MAPI_PEEK = &H80
Global Const MAPI_BODY_AS_FILE = &H200
Global Const MAPI_SUPPRESS_ATTACH = &H800

'* MAPIDetails() flags *

Global Const MAPI_AB_NOMODIFY = &H400

'* Attachment flags *

Global Const MAPI_OLE = &H1
Global Const MAPI_OLE_STATIC = &H2

'* MapiMessage flags *

Global Const MAPI_UNREAD = &H1
Global Const MAPI_RECEIPT_REQUESTED = &H2
Global Const MAPI_SENT = &H4

Function CopyFiles(MfIn As MapiFile, MfOut As MapiFile) As Long

MfOut.FileName = MfIn.FileName
MfOut.PathName = MfIn.PathName
MfOut.Reserved = MfIn.Reserved
MfOut.Flags = MfIn.Flags
MfOut.Position = MfIn.Position
MfOut.FileType = MfIn.FileType
CopyFiles = 1&

End Function

Function CopyRecipient(MrIn As MapiRecip, MrOut As MapiRecip) As Long

MrOut.Name = MrIn.Name
MrOut.Address = MrIn.Address
MrOut.EIDSize = MrIn.EIDSize
MrOut.EntryID = MrIn.EntryID
MrOut.Reserved = MrIn.Reserved
MrOut.RecipClass = MrIn.RecipClass

CopyRecipient = 1&

End Function

Function MAPIAddress(Session As Long, UIParam As Long, Caption As String, nEditFields As Long, Label As String, nRecipients As Long, recips() As MapiRecip, Flags As Long, Reserved As Long) As Long



Dim Info&
Dim rc&
Dim nRecips As Long

ReDim Rec(0 To nRecipients) As MapiRecip
' Use local variable since BMAPIAddress changes the passed value
nRecips = nRecipients

'*****************************************************
' Copy input recipient structure into local
' recipient structure used as input to BMAPIAddress
'*****************************************************

For I = 0 To nRecipients - 1
ignore& = CopyRecipient(recips(I), Rec(I))
Next I

rc& = BMAPIAddress(Info&, Session&, UIParam&, Caption$, nEditFields&, Label$, nRecips&, Rec(), Flags, 0&)

If (rc& = SUCCESS_SUCCESS) Then

'**************************************************
' New recipients are now in the memory referenced
' by Info (HANDLE). nRecipients is the number of
' new recipients.
'**************************************************
nRecipients = nRecips ' Copy back to parameter

If (nRecipients > 0) Then
ReDim Rec(0 To nRecipients - 1) As MapiRecip
rc& = BMAPIGetAddress(Info&, nRecipients&, Rec())

'*********************************************
' Copy local recipient structure to
' recipient structure passed as procedure
' parameter. This is necessary because
' VB doesn't seem to work properly when
' the procedure parameter gets passed
' directory to the BMAPI.DLL Address routine
'*********************************************

ReDim recips(0 To nRecipients - 1) As MapiRecip

For I = 0 To nRecipients - 1
ignore& = CopyRecipient(Rec(I), recips(I))
Next I

End If

End If

MAPIAddress = rc&

End Function


This macro then sends an email out using the above Mapi mail

With MessageOUT
.Reserved = 0
.NoteText = "Finance," & CRLF & CRLF & "Please issue a PO number to " & Senderlong & "." & CRLF & CRLF
.FileCount = 1
.RecipCount = 1
.Subject = Sheets("INTERNAL").Range("A80") & " " & "(1K+) Approved by Richard Freeman Dated" & " " & Today
.MessageType = "IPM.Note"

End With

MessageOUT.NoteText = MessageOUT.NoteText & "Regards," & CRLF
MessageOUT.NoteText = MessageOUT.NoteText & "Richard Freeman"

With Recipients(0)

.RecipClass = 1 'To
.Name = "joebloggs@hotmail.com"

End With

With ATTACHMENTS(0)

'.FileName = "PO.xls"
'.FileType = ""
.Flags = 0
.PathName = "C:POPO.xls"
.Position = -1
.Reserved = 0

End With

lresult = MAPISendMail(0, 0, MessageOUT, Recipients, ATTACHMENTS, 0, 0&)