0

I receive numerous e-mails each morning containing info that I need to forward to relevant parties. These are time sensitive information, hence the need for automating this process.

Some additional info:

  • Sender of original email is always the same
  • Recipients of forwarded emails will always be different. Relevant emails are stated in the original email's body
  • I will also need to edit the subject of the e-mail to include more text after the original e-mail's subject title.

For example:

Original e-mail

<from: xxx@123.com>
Subject: Stackoverflow Sample Test

Main body: 
Please forward this e-mail to: yyy@123.com , zzz@123.com
Please add this into subject title: DONE

Forwarded E-mail

<To: yyy@123.com ; zzz@123.com>
Subject: FW: Stackoverflow Sample Test DONE

Thanks for any help in advance!

Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
Jon
  • 9
  • 2
  • 1
    What have you tried this far? – Sam Oct 08 '18 at 11:01
  • You can set up an [outlook rule to run a macro](https://www.slipstick.com/outlook/rules/run-rules-now-using-macro/). The macro could then pull the addresses and attempt to send the email – Marcucciboy2 Oct 08 '18 at 13:06
  • How will you recognise the emails to be forwarded? Are they from particular people? Does the body containing "Please forward this e-mail to:" identify them? Alternatively, do you read the email body and decide which to forward? Are these emails totally consistent? It will be difficult to automate if each sender has a slightly different header. – Tony Dallimore Oct 08 '18 at 17:27
  • My answer to this question, [How to copy Outlook mail message into excel using VBA or Macros](https://stackoverflow.com/a/12146315/973283), may help you get started. The question is not relevant to you except that the questioner did not realise that a screen shot tells us little about what the email looked like to a VBA macro. The same appearance can be achieved in very different ways. The macro in my answer outputs selected properties of every email in an Inbox to an Excel workbook. This allows you to see what the emails looks like to a VBA macro. … continued in next comment. – Tony Dallimore Oct 08 '18 at 17:42
  • Continued from previous comment: Without knowing the exact format of the text and Html bodies, I do not believe your question can be answered. – Tony Dallimore Oct 08 '18 at 17:42
  • I somehow missed this line in your question: "Sender of original email is always the same". This makes identifying the emails to be processed simple unless they send you other emails.. Are these emails created automatically? If so they are likely to be more consistent than if a human types them. You will still need to determine the exact format of the bodies of these emails using my macro or something similar. However, your objective is looking much more achievable. – Tony Dallimore Oct 08 '18 at 23:29
  • @TonyDallimore hello, thank you for you comments! 1) Recognising the emails: (a) sender is always the same and (b) subject title is always the same. 2) These emails are automated and the exact format is always the same. 3) Exact format of text: They are always in the same table format. The e-mail address that I need to forward to are in the row that is labelled "Remarks:" – Jon Oct 09 '18 at 07:48
  • @Marcucciboy2 hi, i can't do that because a security update in Outlook 2016 removed that function. And I cannot overwrite it in the registry due to security protocols at work. – Jon Oct 09 '18 at 07:49
  • @TonyDallimore I'm new to VBA so I am incrementally trying to code different parts of the automation problem. Currently, I am trying to code such that any new mails that is sent to a folder named "WMS" will be fwded to my own e-mail AND has the subject title "Test" will be auto forwarded back to me. However, can't seem to get the code to work. Getting the error "User-defined type not defined" – Jon Oct 09 '18 at 07:58
  • Developing small routines to explore functionality needed for the total objective, is in my opinion, an excellent way to develop your knowledge. It also works with this site. There is no limit on the number of questions you can ask. Half a dozen questions each containing a small block of code with a brief explanation of what they do and what you hoped they would do will get a much faster answer than a single question that tries to combine all your problems. If fact, the combined question will probably never be answered because it will be unclear. – Tony Dallimore Oct 09 '18 at 18:33
  • Getting the error "User-defined type not defined" Posting an error message without showing the statement that gives the error is of little value. My guess is you have a statement such as `Dim Xxx As Yyy`. Either you have misspelt Yyy or Yyy is defined by a library you have not referenced. My answer will explain references. – Tony Dallimore Oct 09 '18 at 18:38
  • I am trying to code such that any new mails that is sent to a folder named "WMS" will be fwded to my own e-mail. Is "WMS" in some company store to which you have access? VBA can process emails in any store to which you have access. Do you really need a copy in your private store? If you look at Outlook Folder Pane, you will have names against the left edge with indented names such as Inbox and Sent Items underneath. The names against the left edge identify **stores** which are private or public files that hold emails and calendar items and all the other items that Outlook can hold. – Tony Dallimore Oct 09 '18 at 18:51

1 Answers1

0

The code below needs references. Native VBA is limited; it knows nothing about MailItems or Worksheets or Documents or Tables or any other object used by an Office product.

Within the Outlook VBA Editor, click "Tools" then "References". A long list of libraries will be displayed with a few at the top ticked. These ticked libraries will include "Microsoft Library nn.0 Object Library". The value for "nn" will depend on the version of Outlook you use. It is this library that tells VBA about Folders and MailItems and all the other Outlook objects.

The code below needs references to "Microsoft Scripting Runtime" and "Microsoft ActiveX Data Objects n.n Library". On my system, "n.n" is "6.1". If these libraries are not ticked, scroll down the list until you find them and tick them. Next time you click References, these libraries will be at the top of the list.

You say the emails you need to process, all have the same format. You say the data you need is held as a table. Do you mean an Html table or a text table with non-break-spaces to align columns? Tables can look the same but be formatted in very different ways. The code below is the routine I use when I need to investigate the exact format of one or two emails. The answer I referenced above includes the routine I use if I want to investigate lots of emails.

To use the routine below, Insert a new module without Outlook and copy the code below to it. Select one or two of the emails you wish to process and then run InvestigateEmails(). It will create a file on your desktop named "InvestigateEmails.txt" that will contain a few properties of the selected emails. In particular, it will contain the text and Html bodies. The control characters CR, LF and TB will have been replaced by strings but otherwise these bodies will be as they look to a VBA macro. You cannot extract the destination email addresses from the available body or bodies without knowing how they look to a VBA macro.

I said this is the routine I use to investigate one or two emails. This is not the entire truth. My routine outputs many more properties but I have deleted all but those I thought would be useful to you. I can add more properties if I have missed something you need.

Option Explicit
Public Sub InvestigateEmails()

  ' Outputs properties of selected emails to a file.

  ' ???????  No record of when originally coded
  ' 22Oct16  Output to desktop file rather than Immediate Window.

  ' Technique for locating desktop from answer by Kyle:
  ' http://stackoverflow.com/a/17551579/973283
  ' Needs reference to "Microsoft Scripting Runtime"

  Dim Exp As Explorer
  Dim FileBody As String
  Dim Fso As FileSystemObject
  Dim ItemCrnt As MailItem
  Dim Path As String

  Path = CreateObject("WScript.Shell").specialfolders("Desktop")

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Pleaase select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    FileBody = ""
    For Each ItemCrnt In Exp.Selection
      With ItemCrnt
        FileBody = FileBody & "From (Sender): " & .Sender & vbLf
        FileBody = FileBody & "From (Sender name): " & .SenderName & vbLf
        FileBody = FileBody & "From (Sender email address): " & _
                              .SenderEmailAddress & vbLf
        FileBody = FileBody & "Subject: " & CStr(.Subject) & vbLf
        Call OutLongText(FileBody, "Text: ", Replace(Replace(Replace(.Body, vbLf, _
                         "{lf}" & vbLf), vbCr, "{cr}"), vbTab, "{tb}"))
        Call OutLongText(FileBody, "Html: ", Replace(Replace(Replace(.HtmlBody, vbLf, _
                         "{lf}" & vbLf), vbCr, "{cr}"), vbTab, "{tb}"))
        FileBody = FileBody & "--------------------------" & vbLf
      End With
    Next
  End If

  Call PutTextFileUtf8NoBOM(Path & "\InvestigateEmails.txt", FileBody)

End Sub
Public Sub OutLongText(ByRef FileBody As String, ByVal Head As String, _
                       ByVal Text As String)

  Dim PosEnd As Long
  Dim LenOut As Long
  Dim PosStart As Long

  If Text <> "" Then
    PosStart = 1
    Do While PosStart <= Len(Text)
      PosEnd = InStr(PosStart, Text, vbLf)
      If PosEnd = 0 Or PosEnd > PosStart + 100 Then
        ' No LF in remainder of text or next 100 characters
        PosEnd = PosStart + 99
        LenOut = 100
      Else
        ' Output upto LF.  Restart output after LF
        LenOut = PosEnd - PosStart
        PosEnd = PosEnd
      End If
      If PosStart = 1 Then
        FileBody = FileBody & Head
      Else
        FileBody = FileBody & Space(Len(Head))
      End If
      FileBody = FileBody & Mid$(Text, PosStart, LenOut) & vbLf
      PosStart = PosEnd + 1
    Loop
  End If

End Sub
Public Sub PutTextFileUtf8NoBOM(ByVal PathFileName As String, ByVal FileBody As String)

  ' Outputs FileBody as a text file named PathFileName using
  ' UTF-8 encoding without leading BOM

  ' Needs reference to "Microsoft ActiveX Data Objects n.n Library"
  ' Addition to original code says version 2.5. Tested with version 6.1.

  '  1Nov16  Copied from http://stackoverflow.com/a/4461250/973283
  '          but replaced literals with parameters.
  ' 15Aug17  Discovered routine was adding an LF to the end of the file.
  '          Added code to discard that LF.
  ' 11Oct17  Posted to StackOverflow
  '  9Aug18  Comment from rellampec suggested removal of adWriteLine from
  '          WriteTest statement would avoid adding LF.
  ' 30Sep18  Amended routine to remove adWriteLine from WriteTest statement
  '          and code to remove LF from file. Successfully tested new version.

  ' References: http://stackoverflow.com/a/4461250/973283
  '             https://www.w3schools.com/asp/ado_ref_stream.asp

  Dim BinaryStream As Object
  Dim UTFStream As Object

  Set UTFStream = CreateObject("adodb.stream")

  UTFStream.Type = adTypeText
  UTFStream.Mode = adModeReadWrite
  UTFStream.Charset = "UTF-8"
  UTFStream.Open
  UTFStream.WriteText FileBody

  UTFStream.Position = 3 'skip BOM

  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open

  UTFStream.CopyTo BinaryStream

  UTFStream.Flush
  UTFStream.Close
  Set UTFStream = Nothing

  BinaryStream.SaveToFile PathFileName, adSaveCreateOverWrite
  BinaryStream.Flush
  BinaryStream.Close
  Set BinaryStream = Nothing

End Sub
Tony Dallimore
  • 12,335
  • 7
  • 32
  • 61