Shure,
Here is a code:
'--------------------------------------------------------------------
' This procedure sets an object variable to the MAPI Session object
' using the CreateObject() function. Then, it logs on to the session
' using a predefined profile. As soon as you are logged on,
' the procedure creates
' a new message and adds it to the Messages collection of the Outbox
' of the user. Then, it creates two recipients (one on the TO: line and
' one on the CC: line) and then adds both to the Recipients collection
' of the message. Next, it resolves the names of all recipients.
' Then, it attaches a sample file before filling in the Subject,
' Text, and Importance attributes of the message.
'--------------------------------------------------------------------
Sub SendMAPIMessage(ByVal MsgBody As String, ByVal Subject As String, ByVal EmailTo As String, ByVal EmailCc As String, ByVal EmailBcc As String, ByVal EmailFrom As String, ByVal FileLocation As String, ByVal FileName As String)
Dim objApp As Outlook.Application
Set objApp = Application
Dim l_Msg As MailItem
Dim colAttach As Outlook.Attachments
Dim l_Attach As Outlook.Attachment
Dim MapiSession As MAPI.Session
Dim MapiMessage As MAPI.Message
Dim MapiRecipient As MAPI.Recipient
Dim MapiAttachment As MAPI.Attachment
Dim MapiAttachments As MAPI.Attachments
Dim Recpt
Dim errObj As Long
Dim errMsg
On Error GoTo MAPITrap
' Create the MAPI Session.
Set MapiSession = CreateObject("Mapi.Session")
Dim strProfileInfo As String
strProfileInfo = "newyork1" & vbLf & "TW Data"
MapiSession.Logon "TW Data", "TreadwayS", False, True, 0, False, strProfileInfo
' Add a message to the Outbox.
Set MapiMessage = MapiSession.Outbox.Messages.Add
With MapiMessage
Set MapiRecipient = MapiMessage.Recipients.Add
'MapiRecipient.Name = "Nancy Davolio"
MapiRecipient.Name = EmailTo
MapiRecipient.Type = mapiTo
Set MapiRecipient = MapiMessage.Recipients.Add
MapiRecipient.Name = EmailCc
MapiRecipient.Type = mapiCc
Set MapiRecipient = MapiMessage.Recipients.Add
MapiRecipient.Name = EmailBcc 'Leon. 10/05/05
MapiRecipient.Type = mapiBcc
' Resolve each recipient's e-mail name.
' Starting with Outlook version 8.03 (ref. Q172623)
' OLE Messaging 1.0 was replaced with Active Messaging 1.1.
' Outlook 98 (version 8.5) replaced Active Messaging
' with Microsoft CDO (Collaborative Data Objects) 1.21.
' OLE Messaging 1.0 uses a zero-based Recipients collection;
' Active Messaging 1.1 and Microsoft CDO 1.21 are 1-based.
For Recpt = 1 To .Recipients.Count
.Recipients(Recpt).Resolve showdialog:=False
Next
Set MapiAttachments = MapiMessage.Attachments
Set MapiAttachment = MapiAttachments.Add(FileLocation)
With MapiAttachment
.Name = FileName & Format(Now, "_dd-mmm-yyyy-Hh-Nn-Ss") & ".xml" 'Leon. 10/03/05
.Type = mapiFileData
.Source = FileLocation
.ReadFromFile FileName:=FileLocation
.Position = 2880
End With
.Subject = Subject '"My Subject"
.Text = MsgBody ' "This is the text of my message." & vbCrLf & vbCrLf
.Send showdialog:=False 'True '
End With
Set MapiSession = Nothing ' Clear the object variable.
'MsgBox ("Done")
MAPIExit:
Exit Sub
MAPITrap:
errObj = Err - vbObjectError ' Strip out the OLE automation error.
Select Case errObj
Case 275 ' User cancelled sending of message.
Resume MAPIExit
Case Else
errMsg = MsgBox("Error " & errObj & " was returned.")
Resume MAPIExit
End Select
End Sub
Thanks allot,
Leon.
|
