Outlook Macro to read table from Microsoft word document

[Srinivasan]

Hello All, This is my first post in this forum. Any help you could provide is greatly appreciated. I wanted to create a Macro in Outlook to read a table from Microsoft word document and copy that table in body of the email.I am looking for a Macro that will be executed from outlook. The word document contains 3 tables and wanted to paste 2nd table in the body of the email. Also in the subject line of the email it should display current month value along with a literal. For ex: In subject line should contain "Test mail on" and Current Month.

 

[Peter_SSs]

I have moved your thread from the Excel Questions forum as it appears to have nothing to do with Excel. I think you are more likely to find a helper in this forum.

 

[ZVI]

Hi,

Let’s assume that workbook Wb1.doc with 3 tables is already open.
Then put the below code to the Outlook's code module and run it.
New email in Rich Text format will be created with copy of table #2 from Wb1.doc in the email's body.

Sub NewMailWithTableFromWord()
  With Application.CreateItem(olMailItem)
    .BodyFormat = olFormatRichText
    '.To = "..." ' <-- Put email of the recipient here
    '.CC = "..." ' <-- Put email of 'copy to' recipient here
    .Subject = "Test mail on " & Format(Date, "mmmm")
    .Display
  End With
  With GetObject(, "Word.Application").ActiveDocument
    .Content = "Hi," & vbLf & vbLf & "Below is the copied table #2" & vbLf & vbLf
    .Characters(.Characters.Count).FormattedText = .Application.Documents("Wb1.doc").Tables(2).Range.FormattedText
    .Content.InsertAfter vbLf & "Best Regards," & vbLf & .Application.UserName
  End With
End Sub

Change this code to suit your conditions if possible.

 

[Srinivasan]

Thank you MVP.... I tried this code... I got an error that "the requested member of the collection does not exist". I checked my word document and it has 3 tables. The message "Hi,Below is the copied table #2" is writing in to the word document that I opened. It was creating an email with subject but no table is attached to the email body. I commented the content portion and executed , this time there was no error message , email created with subject line with no table attached to the email body. I am not a VB expert , really appreciate help on this. Also is there a way to read specific columns in a table in word document? In this instance the table 2 has 5 columns in it and I wanted to write columns 1,3 and 5. Appreciate your time and response.

 

[ZVI]

I'm not expert in Word too, Excel is my preference.
Code works only if Word is the default editor for Outlook's messages, you need to set it up via Outlook Settings.
Below is the same code but with checking of this setting

Sub NewMailWithTableFromWord_01()
  Dim olEditorType As Long
  With Application.CreateItem(olMailItem)
    olEditorType = .GetInspector.EditorType
    If olEditorType = olEditorRTF Or olEditorType = olEditorWord Then
      .BodyFormat = olFormatRichText
      '.To = "..." ' <-- Put email of the recipient here
      '.CC = "..." ' <-- Put email of 'copy to' recipient here
      .Subject = "Test mail on " & Format(Date, "mmmm")
      .Display
      With GetObject(, "Word.Application").ActiveDocument
        .Content = "Hi," & vbLf & vbLf & "Below is the copied table #2" & vbLf & vbLf
        .Characters(.Characters.Count).FormattedText = .Application.Documents("Wb1.doc").Tables(2).Range.FormattedText
        .Content.InsertAfter vbLf & "Best Regards," & vbLf & .Application.UserName
      End With
    Else
      MsgBox "Word have to be default Editor for Outlook messages," & vbLf & "set it up in Outlook Settings", vbExclamation, "Error"
    End If
  End With
End Sub

 

[ZVI]

The same with deleting of columns 4 & 2 from the copied table:

Sub NewMailWithTableFromWord_02()
  Dim olEditorType As Long
  With Application.CreateItem(olMailItem)
    olEditorType = .GetInspector.EditorType
    If olEditorType = olEditorRTF Or olEditorType = olEditorWord Then
      .BodyFormat = olFormatRichText
      '.To = "..." ' <-- Put email of the recipient here
      '.CC = "..." ' <-- Put email of 'copy to' recipient here
      .Subject = "Test mail on " & Format(Date, "mmmm")
      .Display
      With GetObject(, "Word.Application").ActiveDocument
        ' Insert the top lines
        .Content = "Hi," & vbLf & vbLf & "Below is the copied table #2" & vbLf & vbLf
        ' Copy table #2 to the message's body
        .Characters(.Characters.Count).FormattedText = .Application.Documents("Wb1.doc").Tables(2).Range.FormattedText
        ' Delete (in reverse order) columns 4 & 2 from the copied table
        .Content.Tables(1).Columns(4).Delete
        .Content.Tables(1).Columns(2).Delete
        ' Insert the bottom lines
        .Content.InsertAfter vbLf & "Best Regards," & vbLf & .Application.UserName
      End With
    Else
      .Display
      MsgBox "Word have to be default Editor of Outlook messages," & vbLf & "set it up in Outlook Settings", vbExclamation, "Error"
    End If
  End With
End Sub

 

[Srinivasan]

Thank you MVP .. Let me try this new code.... You are so helpful