Create email with same body but different addresses (using drop down menu)

[jmcconnell]

So I've got a drop down menu which creates an email. Body of the email is always the same but the addresses and subject change depending on the option chosen from the drop down list. It pulls the email addresses from a table and also inserts the contents of the clipboard to the body of the email.

The only way I can get it to populate with different email addresses is to keep repeating the full section of code below and change the cell location in the .To &.From sections. Is there a way to streamline this:


Private Sub Cark()


Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object


On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0


Set OutMail = OutApp.CreateItem(0)


With OutMail
.BodyFormat = 2
'Email addresses pulled from spreadsheet
.To = Sheets("emails").Range("A1")
.CC = Sheets("emails").Range("C1")
.Subject = "Cark fault"


Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)


'Body of email
If Time < TimeValue("12:00:00") Then
oRng.Text = "Good Morning," & vbCr & vbCr & _
"Please see the fault below:" & vbCr & vbCr
ElseIf Time > TimeValue("12:00:00") And Time < TimeValue("17:00:00") Then
oRng.Text = "Good Afternoon," & vbCr & vbCr & _
"Please see the fault below:" & vbCr & vbCr
Else
oRng.Text = "Good Evening," & vbNewLine & vbNewLine & _
"Please see the fault below:" & vbCr & vbCr
End If
'Insert clipboard contents
oRng.collapse 0
oRng.Paste
.display
End With
'Tidyup
Set OutApp = Nothing
Set OutMail = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub

So can I create a sub that contains the body of the email separate to the email address section?

Thank you.
Kind regards,
James.

 

[Logit]

.
Haven't tested for all times of the day ... but I believe this should work. Or at least give you an idea which direction to go ...

Option Explicit


Sub Cark()




Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object




On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0




Set OutMail = OutApp.CreateItem(0)




With OutMail
    .BodyFormat = 2
    'Email addresses pulled from spreadsheet
    '.To = Sheets("emails").Range("A1")
    '.CC = Sheets("emails").Range("C1")
    
    
    
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    Set oRng = wdDoc.Range(0, 0)
    
    
    'Body of email
    If Time < TimeValue("12:00:00") Then
    
        .body = "Good Morning," & vbCr & vbCr & _
        "Please see the fault below:" & vbCr & vbCr
        .To = Sheets("emails").Range("A1").Value
        .CC = Sheets("emails").Range("C1").Value
        
    ElseIf Time > TimeValue("12:00:00") And Time < TimeValue("17:00:00") Then
    
        .body = "Good Afternoon," & vbCr & vbCr & _
        "Please see the fault below:" & vbCr & vbCr
        .To = Sheets("emails").Range("A2").Value
        .CC = Sheets("emails").Range("C2").Value
        
    Else
    
        .body = "Good Evening," & vbNewLine & vbNewLine & _
        "Please see the fault below:" & vbCr & vbCr
        .To = Sheets("emails").Range("A3").Value
        .CC = Sheets("emails").Range("C3").Value
        
    End If
    
    .Subject = "Cark fault"
    
    'Insert clipboard contents
    oRng.collapse 0
    oRng.Paste
    .display
    
End With


'Tidyup
Set OutApp = Nothing
Set OutMail = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing


End Sub

 

[daverunt]

Hi,

You need to access whatever kind of dropdown selection you are using.

E.g if it were a Combo box:

.To = Worksheets("Sheet1").ComboBox1.Value

Same for the .Subject.

 

[jmcconnell]

Thanks Dave & Logit for the assistance.

Sorry, I never explained it very well. So i've got a drop down menu where I select an option (in the code above its 'Cark') I then press a button which generates the email as per my code. However if I select a different option from the menu and press the button it generates the same email but the addresses are different.

However, the only way I've managed this is to repeat the same section of code above over and over for every option on my combo box list and just keep changing the .To and .From.

I was hoping there was another way around this?

Thanks again!!

 

[Logit]

.
I still believe my code will accomplish the goal unless the emails should not change based on the time of day.
Are you saying disregard the time of day altogether ?

 

[daverunt]

Well I thought I understood but now I'm lost.

Is what you are saying is that you generate the same email and addresses/subject for every option and you want to use different email addresses and subject depending on the selected option?

If so it sounds like you could use 'Select Case' to change those parameters in the email at generation time dependent on the option selected.

If not

Logit - it's all yours!

 

[jmcconnell]

Hi both thanks again. @daverunt, that's it exactly. Thanks, I'll look at using 'select case'

Thanks again to both of you for the help.