Excel workbook to outlook template - excel

Question

Please see attached image below for reference.
I have an excel workbook that i need to input data into every day on the fly. After inputting data i then need to re input the data into an outlook template and send it to clients.
My outlook template contains a basic table as seen in the picture.
What i want to do is after inputting the data into excel, click the button and it will automatically open the outlook template and fill in the data from the excel workbook ready to be sent.
I've been copying and pasting the data in but its starting to get out of hand because several hundred of these emails need to be done each day.
Any suggestions would greatly be appreciated.

Answer 1

Here's something I use for simple emails - pretty generic but you can tweak as you wish.
Select a row in your data and run the macro. Adjust the HEADER_ROW and NUM_COLS constants to suit your layout.
Sub NotificationMail()
Const HEADER_ROW As Long = 1 '<< the row with column headers
Const NUM_COLS As Long = 7 '<< how many columns of data
Const olMailItem = 0
Const olFolderInbox = 6
Dim ol As Object, fldr, ns, msg
Dim html As String, c As Range, colReq As Long, hdr As Range
Dim rw As Range
On Error Resume Next
Set ol = GetObject(, "outlook.application")
On Error GoTo 0
If ol Is Nothing Then
On Error Resume Next
Set ol = CreateObject("outlook.application")
Set ns = ol.GetNamespace("MAPI")
Set fldr = ns.GetDefaultFolder(olFolderInbox)
fldr.display
On Error GoTo 0
End If
If ol Is Nothing Then
MsgBox "Couldn't start Outlook to compose mail!", vbExclamation
Exit Sub
End If
Set msg = ol.CreateItem(olMailItem)
Set rw = Selection.Cells(1).EntireRow
msg.Subject = "Here's your information"
html = "<style type='text/css'>"
html = html & "body, p {font:10pt calibri;padding:40px;}"
html = html & "table {border-collapse:collapse}"
html = html & "td {border:1px solid #000;padding:4px;}"
html = html & "</style>"
html = html & "<p>Your request has been updated:</p>"
html = html & "<table>"
For Each c In rw.Cells(1).Resize(1, NUM_COLS).Cells
If c.Column <> 4 Then '<<< EDIT to exclude ColD
Set hdr = rw.Parent.Cells(HEADER_ROW, c.Column) '<< get the header text for this cell
html = html & "<tr><td style='background-color:#DDD;width:200px;'>" & _
hdr.Value & _
"</td><td style='width:400px;'>" & Trim(c.Value) & "</td></tr>"
End If 'we want this cell
Next c
html = html & "</table>"
msg.htmlbody = html
msg.display
End Sub

Answer 2

here is some code i have for reference
it shows how to create tables and how to address cells
has lot of extra stuff
just step through it
Sub aTestEmail()
Dim outMail As Outlook.mailItem
Set outMail = Application.CreateItem(olMailItem)
outMail.BodyFormat = olFormatHTML
outMail.Display (False) ' modeless
Dim wd As Document
' Set wd = Application.ActiveInspector.WordEditor
Set wd = outMail.GetInspector.WordEditor
' wd.Range.InsertBreak 3 ' section (continuous)
' wd.Range.InsertBreak 3 ' section (continuous)
For i = 0 To 9
wd.Range.InsertParagraphAfter
Next
debug_aTestEmail wd
Stop
Dim rng As Range
Set rng = wd.Range(2, 8)
rng.Select
Debug.Print rng.Text
rng.Collapse (1) ' 0 - left, 1 - right
rng.Select
wd.Content.Select
' Debug.Print wd.Content.Text
' wd.Range(wd.Characters(104).End, wd.Characters(150).End).Select
' wd.Range(wd.Words(5).Start, wd.Words(10).Start).Select
' wd.Range(wd.Words(5).Start, wd.Words(10).End).Select
wd.Range(wd.Words(5).End, wd.Words(10).End).Select
' wd.Range.Select
' wd.Sentences(1).Select
' wd.Sentences(1).Words(1).Select
' wd.Sentences(1).Words(5).Select
' wd.Sentences(1).Words(10).Select
' wd.Sentences(5).Characters(10).Select
' wd.Sentences(5).Characters(10).Select
' wd.Words(10).Select
' wd.Words(11).Select
' wd.Range.Words(10).Select
' wd.Range.Words(11).Select
' debug_aTestEmail wd
' wd.Characters(4).Select
wd.Tables.Add Range:=wd.Characters(8), NumRows:=5, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
wd.Tables.Add Range:=wd.Characters(3), NumRows:=5, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
wd.Tables(1).Range.Words(1).Select
wd.Tables(1).Range.Words(2).Select
wd.Tables(1).Columns(1).Cells(1).Select
wd.Tables(1).Columns(1).Cells(2).Select
wd.Tables(1).Columns(1).Cells(3).Select
wd.Tables(1).Columns(1).Cells(4).Select
wd.Tables(1).Columns(1).Cells(5).Select
Debug.Print wd.Sentences(1).Words.Count
Debug.Print wd.Words.Count
Dim tabl As Tables
Set tabl = wd.Tables
tabl(1).Style = "Grid Table 4 - Accent 3" ' get this name from "table design" tab (hover over whichever style you like and a tool tip will give you the name)
' tabl(1).ApplyStyleHeadingRows = True
' tabl(1).ApplyStyleLastRow = False
' tabl(1).ApplyStyleFirstColumn = True
' tabl(1).ApplyStyleLastColumn = False
' tabl(1).ApplyStyleRowBands = True
' tabl(1).ApplyStyleColumnBands = False
tabl(1).Range.InsertParagraph
tabl(1).Cell(1, 1).Range.InsertParagraph
tabl(1).Cell(2, 1).Range.InsertParagraph
tabl(1).Cell(3, 1).Range.InsertParagraph
tabl(1).Cell(1, 1).Range.InsertBefore "cell1"
tabl(1).Cell(2, 1).Range.InsertBefore "cell2"
tabl(1).Cell(3, 1).Range.InsertBefore "cell3"
tabl(1).Cell(4, 1).Range.InsertBefore "cell4"
tabl(1).Cell(5, 1).Range.InsertBefore "cell5"
tabl(2).Cell(1, 1).Range.InsertBefore "cell6"
tabl(2).Cell(2, 1).Range.InsertBefore "cell7"
tabl(2).Cell(3, 1).Range.InsertBefore "cell8"
tabl(2).Cell(4, 1).Range.InsertBefore "cell9"
tabl(2).Cell(5, 1).Range.InsertBefore "cell10"
' wd.Range.InsertBreak 3 ' section (continuous)
' wd.Range.InsertBreak 3 ' section (continuous)
debug_aTestEmail wd
' wd.Sections(2).Range.InsertBefore ("before" & vbCrLf & vbCrLf)
' wd.Sections(2).Range.InsertAfter ("after" & vbCrLf & vbCrLf)
' debug_aTestEmail wd
' wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.1" & vbCrLf & vbCrLf)
' wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.2" & vbCrLf & vbCrLf)
' wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.3" & vbCrLf & vbCrLf)
' wd.Sections(1).Range.Words(wd.Sections(1).Range.Words.Count).InsertBefore ("after1.4" & vbCrLf & vbCrLf)
' For i = 1 To wd.Sections(1).Range.Words.Count
' Debug.Print wd.Sections(1).Range.Words(i).Characters.Count & " ";
' Debug.Print wd.Sections(1).Range.Words(i) & " "
' Next
' debug_aTestEmail wd
' wd.Sections(2).Range.InsertAfter ("after2.1" & vbCrLf & vbCrLf)
' wd.Sections(2).Range.InsertAfter ("after2.2" & vbCrLf & vbCrLf)
' wd.Sections(2).Range.InsertAfter ("after2.3" & vbCrLf & vbCrLf)
' wd.Sections(2).Range.InsertAfter ("after2.4" & vbCrLf & vbCrLf)
Set wd = Nothing
Set outMail = Nothing
End Sub
Sub debug_aTestEmail(wd As Document)
Debug.Print "------------------------------------------------"
Debug.Print " wd.Sections.Count : " & wd.Sections.Count
Debug.Print " wd.Paragraphs.Count : " & wd.Paragraphs.Count
Debug.Print " wd.Sentences.Count : " & wd.Sentences.Count
Debug.Print " wd.Words.Count : " & wd.Words.Count
Debug.Print " wd.Characters.Count : " & wd.Characters.Count
Debug.Print " wd.Range.End : " & wd.Range.End
Debug.Print "wd.StoryRanges.Count : " & wd.StoryRanges.Count
Debug.Print "------------------------------------------------"
Debug.Print wd.Tables.Count
End Sub