Macro help re email solution

[leeagall]

Hi i have the following macro which sends emails from Excel.

From a workbook, it selects data from the active worksheet and the email address from sheet2, all from rows 2, it then successfully transfers the data accordingly to outlook.

Sub NewEmail()

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.from = ""
.to = Worksheets("Sheet2").Range("B2").Value
.CC = ""
.BCC = ""
.Subject = "Operation " & Range("E2") & " Action" '& Range("F3")
.Body = "REF: Action Re " & Range("E2").Text & vbNewLine & vbNewLine & Range("A2") & "," & vbNewLine & vbNewLine & "Please can you progress the following:" & vbNewLine & vbNewLine & Range("F2") & ", " & Range("C2") & vbNewLine & vbNewLine & vbNewLine & "SCS Supervision"
.Display

End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing


End Sub

Is there a way for the macro to offer a pop up box to select:-

1. one email address from a list of emails from sheet2 in column B
2. one relevant row from the active sheet, ie A2, but only cells A2, D2, E2, G2, from within that row which will form the to, subject and body of the email accordingly.

I hope that makes sense?

kind regards

Lee

 

[leeagall]

i think i have sorted the selection of the data from a row in excel by highlighting the row concerned. I will post the code in the morning. however is not from a pop up box.

However is it still possible to select the email address from a pop up box referencing another worksheet with the list of email addresses.

regards

lee

 

[leeagall]

Here is the further code which when the user selects a row or cell from that row it collects data from that row including the email address.

My ongoing question is to how to either select an email address from a list on a different worksheet via a pop up box or when the code selects the name for the recipient, ie Range A below, the code looks up a corresponding email address.

I hope this makes sense?


Sub EmailActions()

Dim OutApp As Object
Dim OutMail As Object
Dim i As Integer
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = Sheets("Sheet1").Range("B" & ActiveCell.Row).Value
.CC = ""
.BCC = ""

.Subject = "Operation " & Range("E" & ActiveCell.Row).Value & " Action"

.Body = "REF: Action Re Operation " & Range("E" & ActiveCell.Row).Value & vbNewLine & vbNewLine & Range("A" & ActiveCell.Row).Value & "," & vbNewLine & vbNewLine & "Please can you progress the following action:" & vbNewLine & vbNewLine & Range("F" & ActiveCell.Row).Value & ", " & Range("C" & ActiveCell.Row).Value & vbNewLine & vbNewLine & vbNewLine & "Can you please E Mail me to result the action." & vbNewLine & vbNewLine & vbNewLine & "SCS Supervision"

.Display

End With

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

 

[daverunt]

You could mess around with this. It allows you to select a name from a range with Input box. it's not particularly tidy.

Sub box_list()
Dim v(1 To 10) As Long
    Dim j As Long
    Dim i As Long
 
j = 1
' email addresses in Range starting at B2
For i = 2 To 7
   If Sheets("Sheet2").Range("B" & i).Value <> "" Then
   j = i
   boxList = boxList & j & " - " & Sheets("Sheet2").Range("B" & i).Value & " " & vbCr
 
   End If
Next
   NumSelect = InputBox("Enter  number to choose." & vbCr & vbCr & boxList)
 
   mailName = MsgBox(Range("B" & NumSelect).Value)
 
 
End Sub

 

[leeagall]

thank you for that it is a help but how do i get it to paste into the TO box in the email?

regards

lee

 

[daverunt]

Hi,

sorry didn't catch your last post.
See the line marked changed code. I have just removed the MsgBox

For the Outlook part of the macro;

.To = mailName

Sub box_list()
Dim v(1 To 10) As Long
    Dim j As Long
    Dim i As Long
 
j = 1
' email addresses in Range starting at B2
For i = 2 To 7
   If Sheets("Sheet2").Range("B" & i).Value <> "" Then
   j = i
   boxList = boxList & j & " - " & Sheets("Sheet2").Range("B" & i).Value & " " & vbCr
 
   End If
Next
   NumSelect = InputBox("Enter  number to choose." & vbCr & vbCr & boxList)
 
   mailName = Range("B" & NumSelect).Value ----------- changed code
 
 
 
End Sub

 

[leeagall]

thank you for your help