Hi
Can anyone help. I am a relative newcomer to VB and am trying to find / write some code to do the following
I have an excel workbook with a worksheet that has two columns entitled, “firstname” and “Surname"
I would like to search the column A (firstname) based on criteria and then drop the firstname with the surname into the body of an email
So if I have a criteria of “Dave” with the following table
Firstname Surname
Dave Smith
Bob Johnson
Dave Jones
Terry Palin
Ken Scott
The email would then look like this
Person 1
First Name: Dave
Surname: Smith
Person 2
First Name: Dave
Surname: Jones
There could be more than two Daves so the email would grow or shrink depending on the number of rows with a Dave
I have attempted to use the code below but it does not work
Any help would be appreciated
Please bear in mind that I do not fully understand this code but have copied it from various sources and cannot get it to work
Sub Button2_Click()
Dim C As Range
Dim P As Long
Dim firstAddress As String
Dim OutApp As Object
Dim OutMail As Object
Dim exptrknumber As String
Dim claimantemail As String
Dim ccemail As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
createemail:
On Error Resume Next
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "EMEA Morning Report - " & Date
With Worksheets("Incidents").Range("A1:A5000")
Set C = .Find("DAVE", LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Row
Do
FirstName = ["A"& C.Row]
Surname = ["B"& C.Row]
.BodyFormat = olFormatHTML
.HTMLBody = "Person ” & C.Row
.HTMLBody = .HTMLBody & "<br/><br/><b> First Name: </b>" " & FirstName
.HTMLBody = .HTMLBody & "<br/><br/><b>Surname: </b>" & Surname
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Row <> firstAddress
End If
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End With
End Sub
Can anyone help. I am a relative newcomer to VB and am trying to find / write some code to do the following
I have an excel workbook with a worksheet that has two columns entitled, “firstname” and “Surname"
I would like to search the column A (firstname) based on criteria and then drop the firstname with the surname into the body of an email
So if I have a criteria of “Dave” with the following table
Firstname Surname
Dave Smith
Bob Johnson
Dave Jones
Terry Palin
Ken Scott
The email would then look like this
Person 1
First Name: Dave
Surname: Smith
Person 2
First Name: Dave
Surname: Jones
There could be more than two Daves so the email would grow or shrink depending on the number of rows with a Dave
I have attempted to use the code below but it does not work
Any help would be appreciated
Please bear in mind that I do not fully understand this code but have copied it from various sources and cannot get it to work
Sub Button2_Click()
Dim C As Range
Dim P As Long
Dim firstAddress As String
Dim OutApp As Object
Dim OutMail As Object
Dim exptrknumber As String
Dim claimantemail As String
Dim ccemail As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
createemail:
On Error Resume Next
With OutMail
.to = ""
.CC = ""
.BCC = ""
.Subject = "EMEA Morning Report - " & Date
With Worksheets("Incidents").Range("A1:A5000")
Set C = .Find("DAVE", LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Row
Do
FirstName = ["A"& C.Row]
Surname = ["B"& C.Row]
.BodyFormat = olFormatHTML
.HTMLBody = "Person ” & C.Row
.HTMLBody = .HTMLBody & "<br/><br/><b> First Name: </b>" " & FirstName
.HTMLBody = .HTMLBody & "<br/><br/><b>Surname: </b>" & Surname
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Row <> firstAddress
End If
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End With
End Sub