Article ID: 195569
Article Last Modified on 7/1/2004
Sub Main()
Dim objSess As MAPI.Session
Dim objMsg As Message
Dim objSentMsg As Message
Dim objMyField As Field
Dim objMessColl As Messages
Dim objMsgFilter As MessageFilter
Dim objInfoStores As InfoStores
Dim objRootFolder As Folder
Dim objFolders As Folders
Dim objSentItems As Folder
Dim objOutbox as Folder
Set objSess = CreateObject("mapi.session")
objSess.Logon "YourProfileName" 'Put a valid profile name here.
Set objOutbox = objSess.Outbox
Set objMsg = objOutbox.Messages.Add
'Add some default data to your message before showing it to the user.
With objMsg
.Text = "This is my text."
.Subject = "This is my subject."
.Recipients.Add Name:="YourRecipientAddress" 'Put a valid
'recipient name here.
.Recipients.Resolve
End With
' Add a dummy field with unique content to the message object
' to identify the message, later on. If guaranteed uniqueness is
' important a GUID would be more appropriate but for simplicity we
' will use the current "system date and time" for the content of the
' field
Mytime = Now
Set objMyfield = objMsg.Fields.Add("MyField", 8)
objMyfield.Value = Mytime
myfieldID = objMyfield.ID
' Save the changes you made to the message.
objMsg.Update refreshobject:=True
' Display the message window.
objMsg.Send ShowDialog:=True
' Get the "Sent Items" Folder
' Note: If you use CDO 1.2 or CDO 1.21 library, you can get the "Sent
' Items" folder by simply calling GetDefaultFolder method of the
' Session object as follows. If this is the case, uncomment the
' following line of code and comment out the lines in between ' *\*
' and ' */*
'Set objSentItems = objSess.GetDefaultFolder(3)
' *\*
Set objInfostore = objSess.InfoStores
CountInfoStores = objInfostore.Count
FoundMailbox = False
For i = 1 To CountInfoStores
If Mid(objInfostore(i), 1, 7) = "Mailbox" Then
FoundMailbox = True
Set objRootFolder = objInfostore(i).RootFolder
Set objFolders = objRootFolder.Folders
For j = 1 To objfolders.Count
If objFolders(j).Name = "Sent Items" Then
Set objSentItems = objFolders(j)
Exit For
End If
Next
End If
If FoundMailbox = True Then
Exit For
End If
Next
' */*
Set objMessColl = objSentItems.Messages
Set objMsgFilter = objMessColl.Filter
' Setup a filter that passes only messages with the dummy field .
objMsgFilter.Fields(myfieldID) = Mytime
For Each objSentMsg In objMessColl
MsgBox objSentMsg.Subject
Msgbox objSentMsg.Text
Next
Set objSentMsg = Nothing
Set objMyField = Nothing
Set objMessColl = Nothing
Set objMsgFilter = Nothing
Set objSentItems = Nothing
Set objOutbox = Nothing
' Comment out the following lines if you used the GetDefaultFolder
' Method.
' *\*
Set objInfoStore = Nothing
Set objRootFolder = Nothing
Set objFolders = Nothing
' */*
objSess.Logoff
Set objSess = Nothing
End Sub
Keywords: kbhowto kbmsg kbsample KB195569