Copy address from mailbox item to new mail item

[BB_AU]

Hi Guys,

This seems farily simple but all the solutions I have come across look far more detailed than my requirement.

Basically, I have an excel macro tha generates an email with certain text, subject lines and attachments. What it is currently missing is the To and CC details which are manual.

All I want to do is write a macro that will copy the 'to' and 'cc' details from a selected item in the inbox and apply those to the newly created email item. I was going to link this macro to a button on the new message window (remembering that the macro does not create the newmail item it has already been created by the excel macro, the outlook macro will just apply address details to it when ran)

Not sure if its possbile to do that way but I thought it might be straight forward :think:

Thank you.

[gmayor]

The problem is that you can't have two messages selected at the same time, so having Excel produce a macro which creates a message using Outlook from which you wish to call a data from another message, you are going to have to be able to identify the other message to the Excel macro. You would therefore need to get the Excel macro to first interrogate the selected message, then create the new message e.g. as follows, or better still just use the Excel code to create a reply to all to the selected message and replace the unwanted data with your new data.



Dim oOutlookApp As Object
Dim oItem As Object
Dim olMsg As Object
On Error Resume Next
'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")

'Outlook wasn't running
If Err <> 0 Then
MsgBox "Select the message in Outlook first!"
Exit Sub
End If
Set olMsg = oOutlookApp.ActiveExplorer.Selection.Item(1)
'No message selected
If Err <> 0 Then
MsgBox "Select the message in Outlook first!"
Exit Sub
End If
On Error GoTo 0
'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(0)
With oItem
.To = olMsg.To 'If this is a received e-mail 'To' will be you?
.CC = olMsg.CC
'do stuff with your message
.display
End With

[BB_AU]

Thanks for the reply gmayor.

The reply all attempt with replacement of message content looks like a nice solution, it may also be the easier option for some other things. In the interim I did figure out some code to do what was needed anyway.

Sub ReplyEmailList()
' Pulls the sender and cc list from a selected email in the inbox and applies it to currently open new email


Set oMail = ActiveExplorer.Selection.Item(1)


' generate the list for new emails for 'CC'
For Each Recipient In oMail.Recipients
Recipientlist = Recipientlist & ";" & Recipient.Address
Next Recipient


'Apply the To and CC fields for the new email
With Application.ActiveInspector.CurrentItem
.To = oMail.SenderEmailAddress
.CC = Recipientlist
End With


'Resolve the addresses entered, otherwise the code will display until the outlook email updates)
For Each Recipient In ActiveInspector.CurrentItem.Recipients
Recipient.Resolve
Next


End Sub