hobbiton73
11-04-2016, 02:23 AM
Hi, I wonder whether someone may be able to help me please.
I'm trying to use a solution by Ron de Bruin here http://www.rondebruin.nl/win/s1/outlook/bmail5.htm which sends emails to users from a spreadsheet list.
The code works, but I had difficulty in overcoming the Outlook security pop up message. So after some research I found a possible solution to be the use of the 'Send Keys' function.
The problem I have with this is that it creates the emails, but doesn't send them.
I've included my code below:
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim Cell As Range
Dim Src As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set Src = ThisWorkbook.Sheets("List")
On Error GoTo cleanup
Src.Select
For Each Cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If Cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Cell.Value
.Subject = "Access"
.Body = "Hi " & Cells(Cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"I have created an account for you in the following environment: Production." & _
vbNewLine & vbNewLine & _
"Your username and password for this environment is:" & _
vbNewLine & vbNewLine & _
"Username: " & Cells(Cell.Row, "B").Value & _
vbNewLine & _
"Password: " & Cells(Cell.Row, "E").Value & _
vbNewLine & vbNewLine & _
"Please log in at your earliest convenience and change your password to a more secure one. " & _
vbNewLine & vbNewLine & _
"You can do this by clicking on your name on the top menu and select ‘Edit Account’." & _
vbNewLine & vbNewLine & _
"You can use this link to get to the log in page for this environment: " & _
vbNewLine & vbNewLine & _
"PROD: " & _
vbNewLine & vbNewLine & _
"Many thanks and kind regards"
' .send
.Display
Application.Wait (Now + TimeValue("0:00:00"))
Application.SendKeys "%"
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next Cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
I just wonder whether someone may be able to look at this please and let me know where I've gone wrong.
Many thanks and Kind Regards
Chris
I'm trying to use a solution by Ron de Bruin here http://www.rondebruin.nl/win/s1/outlook/bmail5.htm which sends emails to users from a spreadsheet list.
The code works, but I had difficulty in overcoming the Outlook security pop up message. So after some research I found a possible solution to be the use of the 'Send Keys' function.
The problem I have with this is that it creates the emails, but doesn't send them.
I've included my code below:
Sub Email()
Dim OutApp As Object
Dim OutMail As Object
Dim Cell As Range
Dim Src As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set Src = ThisWorkbook.Sheets("List")
On Error GoTo cleanup
Src.Select
For Each Cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If Cell.Value Like "?*@?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Cell.Value
.Subject = "Access"
.Body = "Hi " & Cells(Cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"I have created an account for you in the following environment: Production." & _
vbNewLine & vbNewLine & _
"Your username and password for this environment is:" & _
vbNewLine & vbNewLine & _
"Username: " & Cells(Cell.Row, "B").Value & _
vbNewLine & _
"Password: " & Cells(Cell.Row, "E").Value & _
vbNewLine & vbNewLine & _
"Please log in at your earliest convenience and change your password to a more secure one. " & _
vbNewLine & vbNewLine & _
"You can do this by clicking on your name on the top menu and select ‘Edit Account’." & _
vbNewLine & vbNewLine & _
"You can use this link to get to the log in page for this environment: " & _
vbNewLine & vbNewLine & _
"PROD: " & _
vbNewLine & vbNewLine & _
"Many thanks and kind regards"
' .send
.Display
Application.Wait (Now + TimeValue("0:00:00"))
Application.SendKeys "%"
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next Cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
I just wonder whether someone may be able to look at this please and let me know where I've gone wrong.
Many thanks and Kind Regards
Chris