LinkBack URL
About LinkBacks
Hi Everyone,
I am new to VBA coding, and am hitting brick wall with Youtube. It was suggested this forum/site was fantastic for Excel/VBA support
I have created a basic data entry user form in Excel; but I wanted a command button called "Draft Email" to create a draft email in Outlook with the subject, main body text and an image of the table. However, the problem I am having is I can't seem to have the code select only the top row containing the headers and the last row; as this would be the new data entered each time.
I had it working, but it would put in the whole table, and then when I changed it to get the last row if wouldn't provide the top row 'Headers' anymore.
My coding is below, I just cant see what I am doing wrong any help anyone could provide would be amazing.
Code for whole table in Outlook
Private Sub Draft_Email_Click()
Sheets("Data").Unprotect password:="HealthandSafety01"
Dim OutApp As Object
Dim OutAMail As Object
Dim table As Range
Dim Lastrow As Long
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Data")
Lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set table = ws.Range("A1:I" & Lastrow)
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut
' create email message
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Fire Marshall Fire Checks " & Format(Date, "DD-MM-YY")
.Display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.Range("").Font.Size = 20
.PasteandFormat wdChartPicture
With .InlineShapes(.InlineShapes.Count)
.LockAspectRatio = msoFalse
.Width = 1800
.Height = 200
.InsertParagraghAfter
.InsertParagraghAfter
.InsertParagraghAfter
.InsertAfter ""
.InsertParagraghAfter
.InsertParagraghAfter
.InsertParagraghAfter
End With
End With
.HTMLBody = "<BODY style = font-siz:12pt; font-family;Arial>" & _
"Dear All<p>Please find attached the fire safety checks completed today." & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
Sheets("Data").Protect password:="HealthandSafety01"
End Sub
Code for just the last row on new entered data
Private Sub Draft_Email_Click()
Sheets("Data").Unprotect password:="HealthandSafety01"
Dim OutApp As Object
Dim OutAMail As Object
Dim table As Range
Dim Lastrow As Long
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Data")
Lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set table = ws.Range("A" & Lastrow & ":I" & Lastrow)
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut
' create email message
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Fire Marshall Fire Checks " & Format(Date, "DD-MM-YY")
.Display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.Range("").Font.Size = 20
.PasteandFormat wdChartPicture
With .InlineShapes(.InlineShapes.Count)
.LockAspectRatio = msoFalse
.Width = 1800
.Height = 200
.InsertParagraghAfter
.InsertParagraghAfter
.InsertParagraghAfter
.InsertAfter ""
.InsertParagraghAfter
.InsertParagraghAfter
.InsertParagraghAfter
End With
End With
.HTMLBody = "<BODY style = font-siz:12pt; font-family;Arial>" & _
"Dear All<p>Please find attached the fire safety checks completed today." & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
Sheets("Data").Protect password:="HealthandSafety01"
End Sub
Register To Reply
Bookmarks