Macro that copies and pastes text from an Outlook e-mail into a Word document upon receipt.

[bdhopp]

Hello:

I want to create a custom action in Outlook that will--upon receipt of an e-mail from a specific sender--trigger a macro to copy the text in the Outlook e-mail and paste it into a Word or Excel document. Can anyone help me get started with this? Thank you!

 

[Thxs1138]

I am wondering if this could be made to append to the same file? So instead of creating a new file every time simply add the latest content?

Also what about creating a TEXT file instead of WORD?

Thanks!

 

[Ruddles]

Something like this, perhaps?

[COLOR=black][FONT=Arial][FONT=Verdana]Option Explicit<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]Option Compare Text<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial]<o:p>[FONT=Verdana] [/FONT]</o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial]<o:p>[FONT=Verdana] [/FONT]</o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Dim objMailItem As MailItem<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Dim arrMailItems() As String<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Dim iCount As Integer<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  <o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Dim intFH As Integer<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Dim strFilename As String<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Dim intReply As VbMsgBoxResult<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Dim strSeparator As String<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  <o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  ' this separator will be inserted between each message in the output file<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana][B][COLOR=red]  strSeparator = vbNewLine & String(60, "*") & vbNewLine & vbNewLine<o:p></o:p>[/COLOR][/B][/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]    <o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  ' set your output file name here, for example:-<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana][B][COLOR=red]  strFilename = "C:\Temp\Messages.txt"<o:p></o:p>[/COLOR][/B][/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  ' or start a new file for each day:-<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana][B][COLOR=red]  strFilename = "C:\Temp\" & "Saved_Messages" & "_" & Format(Date, "ddmmmyyyy") & ".txt"<o:p></o:p>[/COLOR][/B][/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  <o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Close<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  intFH = FreeFile()<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Open strFilename For Append As #intFH<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]    <o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  arrMailItems = Split(EntryIDCollection, ",")<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]      <o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  For iCount = 0 To UBound(arrMailItems)<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]    On Error Resume Next<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]    Set objMailItem = Application.Session.GetItemFromID(arrMailItems(iCount))<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]    On Error GoTo 0<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]    If Not objMailItem Is Nothing Then<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]      ' here you can check whether you want to record the mail item by checking<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]      ' objMailItem.SenderName or objMailItem.Subject (for example)<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana][B][COLOR=red]      If objMailItem.Subject Like "[COLOR=blue]*wibble*[/COLOR]" Then<o:p></o:p>[/COLOR][/B][/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]        If LOF(intFH) > 0 Then Print #intFH, strSeparator<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]        Print #intFH, objMailItem.Body<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana][B][COLOR=red]      End If<o:p></o:p>[/COLOR][/B][/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]    End If<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Next iCount<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  <o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]  Close #intFH<o:p></o:p>[/FONT][/FONT][/COLOR]
[COLOR=black][FONT=Arial]<o:p>[FONT=Verdana] [/FONT]</o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Arial][FONT=Verdana]End Sub<o:p></o:p>[/FONT][/FONT][/COLOR]

Just change the bits in red to suit.

Let me know...

 

[Thxs1138]

Will try that... thanks for the quick reply!

 

[Thxs1138]

Ok so it created the macro and ran it. I see my text file and there is a separator but there is no content. I assume this would check the existing mail (not in inbox but a different folder) with the subject I defined and parse the message body into the text file?

Am I missing something?

Edit: It does seem to work as I just checked and there are several separator lines in the text file now. The msg body is rather lenghty and it takes a while before Outlook displays the message so perhaps that is the issue?

 

[Ruddles]

No, the NewMailEx event handler checks incoming mail - it doesn't look at existing mail. The original request was:-

I want to create a custom action in Outlook that will--upon receipt of an e-mail from a specific sender--trigger a macro to copy the text in the Outlook e-mail and paste it into a Word or Excel document

When the code is in place - it has to be in the ThisOutlookSession module - send yourself an email which triggers the conditions you've specified. (If you're checking the sender, you may need to modify the code just whilst you're testing, unless you can get the sender to generate some test messages.)

 

[Thxs1138]

Sorry Ruddles, I should have been more clear. I set it to check the mail subject as that I get more than e-mail from the address.

I assume that the code is working as it does append the text file with an additional separator when I get new e-mails with that subject. The number of separators is equal to the number of e-mails I have gotten that match my criteria; since creating the macro.

The only issue seems to be that the content (message body) is not inserted into the text file... not sure why. My only clue is that is rather long and I do have a move rule in place. I will suspend that rule for now and see if that changes anything. Any additional advice would be appreciated.

Also I apologize for my errant assumption that it might check existing mail.

 

[Thxs1138]

UPDATE: Turning off the move rule didn't help. The macro still appended the text file but still didn't add any content.

 

[Ruddles]

Can you post the latest version of the code you're using? I'll take a look it.

 

[Thxs1138]

Here is the code I am using with obvious edits:

Option Explicit
Option Compare Text

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

Dim objMailItem As MailItem
Dim arrMailItems() As String
Dim iCount As Integer

Dim intFH As Integer
Dim strFilename As String
Dim intReply As VbMsgBoxResult
Dim strSeparator As String

' this separator will be inserted between each message in the output file
strSeparator = vbNewLine & String(60, "*") & vbNewLine & vbNewLine

' set your output file name here, for example:-
strFilename = "C:\Documents and Settings\...\test.txt"

Close
intFH = FreeFile()
Open strFilename For Append As #intFH

arrMailItems = Split(EntryIDCollection, ",")

For iCount = 0 To UBound(arrMailItems)
On Error Resume Next
Set objMailItem = Application.Session.GetItemFromID(arrMailItems(iCount))

On Error GoTo 0
If Not objMailItem Is Nothing Then
' here you can check whether you want to record the mail item by checking
' objMailItem.SenderName or objMailItem.Subject (for example)
If objMailItem.Subject Like "my subject" Then
If LOF(intFH) > 0 Then Print #intFH, strSeparator
Print #intFH, objMailItem.Body
End If
End If
Next iCount

Close #intFH

End Sub

 

[Ruddles]

Place a breakpoint against the statement If objMailItem.Subject Like "my subject" Then and step through the subsequent code. Check that Print #intFH, objMailItem.Body is being executed when you think it is and that objMailItem.Body contains the value you're expecting it to.