How to make a macro to copy some parts of a table to an email that it will create?

Hi,

I'm quite new to VBA but had some experience coding for Excel. I now require a macro to help me solve a problem in Word and email. I hope someone can help me here. Thanks in advance!

The issue is that I need to copy some parts of a table in Word to an email that it will create too.

For eg.

There are two columns to the table, with the 1st row, column 1 being "Name", then 2nd row, column 1 being "Role", the 3rd row, column 1 being "Unit" and the 4th row, column 1 being "Title". On column 2 of the 4 rows are spaces for people to type in.

When one presses a macro button, the macro should create an email with the To field filled out, attaching this Word document to it, with some words on the email.

In addition, I would like the macro to copy for example, the whole of row 1, 2 and 4 and then paste it in the email. That will include all the columns of row 1,2 and 4 but not row 3.

I have the part of creating the email and attaching the document worked out. Now I lack this copying of data.

Once again, I thank you guys for the help!

Hi Joseph,

thanks for the website. It helped me alot. I have identified the code that may be able to solve my problem. However, If I may ask, is the codes for Microsoft Word and Excel the same

I think this part of code can help me copy the table out to the body of an email, currently it copies the cells B15 to B20 in the Excel worksheet. How can I make it to copy the first table in a Word document Is it possible to code it such that it only copies certain rows of the table For example I just need rows 1, 2 and 4 and not row 3 to be copied to the body of the email.

Sub Mail_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set rng = Nothing
On Error Resume Next
Set rng = Sheets("MailRangeSelection").Range("B15:B20").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Yup I would have like to use excel but i'm limited to word only.

Would it be possible to insert an excel worksheet in word and do up a macro from there would it be more complicated

Alternatively, I could use the code to go to the 1st table in the word document and copy it. However I'm not sure how can i paste it in the email. Anyone can enlighten me on that

Thanks.

Hi this is my code for now. I realised i dunno how to copy the whole table. anyone can teach me

Private Sub CommandButton1_Click()

'Delete macro button after user clicks it;

Selection.Delete Unit:=wdCharacter, Count:=1

'Go to first table
Selection.GoTo What:=wdGoToTable, Which:=wdGoToFirst, _
Count:=1, Name:=""
'Copy the table

'Save document with user changes

Dim filePath

filePath = ActiveDocument.Path & "\" & ActiveDocument.Name

ActiveDocument.SaveAs FileName:=filePath, FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False

MsgBox "File saved locally to: " & filePath

'Sub SendDocumentAsAttachment()

Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem

On Error Resume Next

If Len(ActiveDocument.Path) = 0 Then
MsgBox "Document needs to be saved first"
Exit Sub
End If

Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If

Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem
.To = "recipient@mail.com"


.Subject = "Newjoiner profile to be published"
'The content of the document is used as the body for the email
' .Body = ActiveDocument.Content

.body = vbCr & "Dear Publisher," & vbCr & vbCr & _
"Please publish the following word doc on thenewjoiner page. " & vbCr & vbCr & _
"Best regards," & vbCr & vbCr & _
"a friendly person"

'Paste Table

'Add the document as an attachment, you can use the .displayname property
'to set the description that's used in the message
.Attachments.Add Source:=ActiveDocument.FullName, Type:=olByValue, Position:=1, DisplayName:="Document as attachment"


'To Send

'.Send

'To Display

.Display


End With

If bStarted Then
oOutlookApp.Quit
End If

Set oItem = Nothing
Set oOutlookApp = Nothing

End Sub