In Outlook 2003, you need to use the RDOMail object in Redemption to access the Account property of a mail item. Here is some code that changes the SendAccount from the default account to another account in the OL Profile, for all items in the Outbox. It could be improved by coding an account selection subroutine that reads the accounts in the OL Profile and presents them as a list for the user to select from. In the code provided the new send account is hard-coded.
Sub ChangeSendAccountForAllItems()
On Error Resume Next
Dim oOutlook As Application
Dim olNS As Outlook.NameSpace
Dim sOrigSendAccount As String
Dim sNewSendAccount As String
Dim iNumItemsInFolder As Integer
Dim iNumItemsChanged As Integer
Dim i As Integer
Dim rRDOSession As Redemption.RDOSession
Dim rRDOFolderOutbox As Redemption.RDOFolder
Dim rRDOMail As Redemption.RDOMail
'Create instance of Outlook
Set oOutlook = CreateObject("Outlook.Application")
Set olNS = Application.GetNamespace("MAPI")
'Create instance of Redemption
Set rRDOSession = CreateObject("Redemption.RDOSession")
rRDOSession.Logon
'Set a new Send Account (using Redemption)
'Change this to any SendAccount in your Profile
sNewSendAccount = "ThePreferredSendAccountNameInTheProfile"
Set rRDOAccount = rRDOSession.Accounts(sNewSendAccount)
Response = MsgBox("New Send Account is: " & sNewSendAccount & vbCrLf & _
vbCrLf, _
vbOK + vbInformation, "Change SendAccount for All Items")
'Get items in Outbox folder (value=4) (using Redemption)
Set rRDOFolderOutbox = rRDOSession.GetDefaultFolder(olFolderOutbox)
Set rRDOMailItems = rRDOFolderOutbox.Items
iNumItemsInFolder = rRDOFolderOutbox.Items.Count
iNumItemsChanged = 0
'For all items in the folder, loop through changing Send Account (using Redemption)
For i = 1 To iNumItemsInFolder
Set rRDOItem = rRDOMailItems.Item(i)
rRDOItem.Account = rRDOAccount
rRDOItem.Save
iNumItemsChanged = iNumItemsChanged + 1
'3 lines below for debugging only
'Response = MsgBox("Item " & iNumItemsChanged & " of " & iNumItemsInFolder & " Subject: " & vbCrLf & _
' rRDOItem.Subject & vbCrLf, _
' vbOK + vbInformation, "Change SendAccount for All Items")
Next
Response = MsgBox(iNumItemsChanged & " of " & iNumItemsInFolder & " items " & _
"had the SendAccount changed to " & sNewSendAccount, _
vbOK + vbInformation, "Change SendAccount for All Items")
Set olNS = Nothing
Set rRDOFolderOutbox = Nothing
Set rRDOMailItems = Nothing
Set rRDOItem = Nothing
Set rRDOAccount = Nothing
Set rRDOSession = Nothing
End Sub