Email content into word document (outlook 2010)

[ajhez]

Hi all

I was wondering if anyone had any ideas for the following problem:

I receive an email containing information set out in a two column table in the body of the email itself (i.e. not as an attachment) - an example below:



Name

AJHEZ



Date of Birth

01.01.1950





I will use the information in the second column to populate a standard template word document. Currently I do this process manually, but I wondered if using VBA I could automate or semi-automate this process? FYI - the number of rows and the position of the cells is always the same.

Essentially I think I would need code that:



Opens the target template word document - "Template X Doc"
Somehow copies the contents of the cell in Column 2, Row 1 and pastes that content in Bookmark 1 inside Template X Doc
Carries out step 2 for all of the calls in Column 2 and pastes to the appropriate Bookmarks inside Template X Doc
Saves the completed Template X Doc to my desktop using the value in the cell in Column 2, Row 1 (i.e. the name)


Does anybody think this is possible? I've done something similar in the past from 1 word doc to another word doc, and from an excel sheet to a word doc, but never from Outlook.

Many thanks for any ideas.

Cheers,
AJHEZ

[gmayor]

http://www.gmayor.com/extract_data_from_email.htm covers the issues related to extracting data from an e-mailed message. The example code writes that data to an Excel worksheet, but there is no reason why you could not extract to Word document bookmarks - investigate also the FillBM function www.gmayor.com/useful_vba_functions.htm

[ajhez]

Thanks, Graham. Reading your article has blown my mind as something of a novice at this - apologies!

I had a successful code that took multiple cell data from a row in an excel sheet and pasted it into bookmarks in a template word document, it would then move on to the next active row and create a new document for each active row.

I have, unsuccessfully tried to use that code to achieve the same result here. Essentially I want the same thing to happen, it will copy the contents of each cell in the second column and paste it into the corresponding bookmark in the template letter.


Option Explicit
Const MainFilePath As String = "C:\Users\herriale\Desktop\Outlook\"
Const FilePath As String = "C:\Users\herriale\Desktop\Outlook\Template\"
Dim wd As New Word.Application
Dim CustomerCell As Range
Sub Generate()
Dim doc As Word.Document
wd.Visible = True
Dim CustomerRange As Range
Range("B8").Select
Set CustomerRange = Range( _
ActiveCell, _
ActiveCell.End(xlDown))
For Each CustomerCell In CustomerRange.SpecialCells(xlCellTypeVisible).Cells
Set doc = wd.Documents.Open(MainFilePath & "2016 Template (ER 21.06.2016).doc")
'letteradmin
CopyCell "bmname", 10
CopyCell "bmaddress", 11
CopyCell "bmdateofbirth", 12
End Sub
Sub CopyCell(bmname As String, ColumnOffset As Integer)
wd.Selection.GoTo What:=wdGoToBookmark, Name:=bmname
wd.Selection.TypeText CustomerCell.Offset(0, ColumnOffset).Value
End Sub


No doubt the above, is miles away from what I'm after, as i have no solution for individually selecting the cells in the outlook email table, before then transferring them across to the word document bookmarks.

Do you have any further recommendations for a simpleton?

Thanks,
AJH

[gmayor]

You cannot simply drop-in Excel code to Outlook - even if you could the message is not an Excel file.

As converting the code from my web site, to work with Word rather than Excel, may be a step too far for a novice coder, I have modified it for you. In order to produce the modification, I copied your message with the sample table to an e-mail message I could test.

This showed that the message when tested with the TestLines macro (from the web page, but included below) shows that the lines that represent the columns are two lines apart, thus if you have the first value (say Name) on line 1, the name AJHEZ is on line 3, so you need to add 2 when writing to the bookmark
e.g.
FillBM oDoc, "BMName", Trim(vText(i + 2))

The code example writes to two bookmarks BMName and BMDOB which must already be in the template document which is picked by name from the indicated folder on your desktop.
You can add other rows and bookmarks as required using similar syntax.

If the template is not present, where indicated, the process quits. If the bookmarks don't exist, they will not be written to ... obviously.

To test the code select an appropriate message and run the macro ProcessMsg

Note that if the offset is different for the actual message the results will not be correct, so use the macro to test as described on the web page.


Option Explicit
Sub ProcessMsg()
'Graham Mayor - http://www.gmayor.com
Dim olMsg As MailItem
On Error GoTo lbl_Exit
Set olMsg = ActiveExplorer.Selection.Item(1)
CopyToWord olMsg
lbl_Exit:
Exit Sub
End Sub

Sub CopyToWord(olItem As MailItem)
'Graham Mayor - http://www.gmayor.com
Dim wdApp As Object
Dim oDoc As Object
Dim vText As Variant
Dim sText As String
Dim i As Long
Dim bWdStarted As Boolean
Dim strPath As String
Const strTemplateName As String = "2016 Template (ER 21.06.2016).doc"
Dim fso As Object
strPath = Environ("USERPROFILE") & "\Desktop\Outlook\"

'Use FileExists function to determine the availability of the template
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(strPath & strTemplateName) Then GoTo lbl_Exit

'Get Word if it is running, or open it if not
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
bWdStarted = True
End If
wdApp.Visible = True
On Error GoTo 0

Set oDoc = wdApp.Documents.Add(strPath & strTemplateName)

'Process the message
With olItem
sText = olItem.Body
vText = Split(sText, Chr(13))


'Check each line of text in the message body
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), "Name") > 0 Then
FillBM oDoc, "BMName", Trim(vText(i + 2))
End If

If InStr(1, vText(i), "Date of Birth") > 0 Then
FillBM oDoc, "BMDOB", Trim(vText(i + 2))
End If
Next i
'oDoc.Save
End With

lbl_Exit:
Set wdApp = Nothing
Set oDoc = Nothing
Set olItem = Nothing
Set fso = Nothing
Exit Sub
End Sub

Private Sub FillBM(oDoc As Object, strBMName As String, strValue As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Object
With oDoc
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
oRng.Text = strValue
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

Sub TestLines()
'Graham Mayor - http://www.gmayor.com
Dim olItem As Outlook.MailItem
Dim vText() As String
Dim sText As String
Dim i As Long
For Each olItem In Application.ActiveExplorer.Selection
sText = Replace(olItem.Body, Chr(160), Chr(32))
vText = Split(sText, Chr(13))
For i = 0 To UBound(vText)
sText = "Line " & i & vbCr & vText(i)
If i < UBound(vText) - 1 Then
sText = sText & vbCr & _
"Line " & i + 1 & vbCr & vText(i + 1)
End If
If i < UBound(vText) - 2 Then
sText = sText & vbCr & _
"Line " & i + 2 & vbCr & vText(i + 2)
End If
If MsgBox(sText, vbOKCancel) = vbCancel Then Exit Sub
Next i
Next olItem
lbl_Exit:
Set olItem = Nothing
Exit Sub
End Sub

[ajhez]

Graham - thank you so much for you help! Over and above with the amount of effort - thanks.

It appears to be working now, the only difficulties i'm having is that -

a) the text from the message inputs into the template word document, but it appears to insert a return prior to the text inserting into the bookmark. So this puts the bookmark on the next line of the document (or interrupts the sentence where the bookmark is mid-sentence)

b) where the value text contains an apostrophe it doesn't appear to be able to find the text value. E.g. if the value is Candidate Name then it would be fine, but if the value was Candidate's Name it does not appear to work. This is proving difficult for me as I cannot fix this by simply asking them to change the values so no apostrophes are used as the values received are fixed in their existing form.

Any ideas for a) and/or b) would be gratefully received! However, you've already done a great deal!

Thanks again,
AJHEZ

[gmayor]

I would need to see a sample message (you can change the name etc to maintain privacy before saving it) and a sample of the document template in order to establish what the issues are.
If you are saying that your table may have Candidate Name or Candidate's Name, you may be able to get away with searching for Candidate. It all depends what else is in the message.
Save a message as msg format and the template document and send me a link via my web site contact page to the files (or attach them here).

[ajhez]

1681616817

Please see attached as requested.

Essentially you'll see that I've reduced and anonymised the word doc, but it is just a simple word doc with a table of information at the start and then will have numbered paragraphs of text after that.

The example email shows that the a simple table is used to provide the information which I wish to extract.

Your code had been working fine for this save for the issues outlined about - i.e. not finding the values containing apostrophes and inserting the extracted data but with a return before it was inserted so it was moved to the line below in the template doc. I think the difficult of just searching for candidate will be that this is used multiple times throughout (as are a number of other words) - so ideally it would need to find the exact phrase/value.

Thanks for taking a look!

Cheers,
AJHEZ

[gmayor]

You do need an exact phrase, however from your example, the following will both get the correct values and eliminate the paragraph breaks.


'Check each line of text in the message body
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), " Name") > 0 Then
FillBM oDoc, "BMName", Mid(CStr(vText(i + 2)), 2)
End If

If InStr(1, vText(i), " d.o.b") > 0 Then
FillBM oDoc, "BMDOB", Mid(CStr(vText(i + 2)), 2)
End If
Next i

[ajhez]

Excellent - that's worked perfectly!

I bow to your serious skills and your generosity with your time to help me.

Many thanks,
AJHEZ