Macro to open and populate email

[Rbubbles]

Hi guys,

I'm still relatively new to VBA but I have been following a few threads on here and hope you may be able to help.

I'm currently working on new travel booking spreadsheet for my company and am looking for a macro that will do the following on a selected row.

1) Open a new email message in outlook
2) Fill the "To" field in outlook with the value of column A
3) Fill the body field as per the template below -

Hi [Provider]<o></o>
<o></o>
May you please make the following booking?<o></o>
<o></o>
Traveldate: (Column C) <o></o>
Name: (Column D) <o></o>
Reference number: (Column F) <o></o>
Contactnumber: (Column M) <o></o>
<o></o>
Collection Time: (Column G) <o></o>
Appointment Time: (Column H) <o></o>
Collection Address: (Column I) <o></o>
Destination Address: (Column K) <o></o>
Return Collection Time: (Column O)

Any help would be greatly appreciated!

Thanks!

 

[daverunt]

Hi,

here's a basic mail to get you started. It has no error handling.
It assumes the worksheet name is Sheet1, change as required.
There's no information for the subject field.
Also not clear whether Provider is the person in column D or someone else. So I left it as [Provider].

It is set up to display the message. You can test it and delete messages. Once ready to send mail, uncomment out .Send. Or leave it
as .Display to give it the eyeball then manually press send on the message.

Test on a workbook copy first!

Sub SendEmail_22()

Dim EmailSubject As String
Dim SendTo As String
Dim EmailBody As String
Dim ccTo As String
Dim v(1 To 10) As Long
Dim j As Long
Dim i As Long
 
'The following will ask you to enter a number for the email addresses listed in column A into an input box.
 
j = 1
' email addresses assumed to be starting in A2
For i = 2 To 7
   If Sheets("Sheet1").Range("A" & i).Value <> "" Then
   j = i
   boxList = boxList & j & " - " & Sheets("Sheet1").Range("A" & i).Value & " " & vbCr
 
   End If
Next
   RowSelect = InputBox("Enter  number to choose." & vbCr & vbCr & boxList)
 
   MailName = Range("A" & RowSelect).Value
 
'Or use the following if you just want to select the name in column A
  ' RowSelect = ActiveCell.Row
  ' MailName = Range("A" & RowSelect).Value
  
  
  
'EmailSubject = "Put the subject here or use a cell reference"

EmailBody = "Hi [Provider]" & vbNewLine & vbNewLine _
& "Traveldate: " & Range("A" & RowSelect).Offset(0, 2).Value _
& vbNewLine & "Name: " & Range("A" & RowSelect).Offset(0, 3).Value _
& vbNewLine & "Reference Number: " & Range("A" & RowSelect).Offset(0, 5).Value _
& vbNewLine & "Contactnumber: " & Range("A" & RowSelect).Offset(0, 12).Value _
& vbNewLine & "Collection Time: " & Range("A" & RowSelect).Offset(0, 6).Value _
& vbNewLine & "Appointment Time: " & Range("A" & RowSelect).Offset(0, 7).Value _
& vbNewLine & "Collection Address: " & Range("A" & RowSelect).Offset(0, 8).Value _
& vbNewLine & "Destination Address: " & Range("A" & RowSelect).Offset(0, 10).Value _
& vbNewLine & "Return Collection Time: " & Range("A" & RowSelect).Offset(0, 14).Value _


Set App = CreateObject("Outlook.Application")
Set Itm = App.CreateItem(0)
With Itm
.Subject = EmailSubject
.To = MailName
.CC = ccTo
.Body = EmailBody
.Display
'.Send
End With


Set App = Nothing
Set Itm = Nothing
End Sub