VBA End Email Automation & Email Sent From Box

[jamesmev]

I have a script which looks at my sheet and sends an image/doc based / message / etc based on the sheet information.

However,
I need this to come from a specific email box, which I have set up. When sending I get a pop up asking me to select which box to select.
It is always the second selection.

1. Is there a way to build that selection into the code

secondly -
The script doesn't stop running after the last entry. I need it to stop. Currently I am needing to end it each time.

ANY help is appreciated.

Sub SendByOne()
Dim c As Range
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim i As Integer
On Error Resume Next
Dim tempFilename As String




For Each c In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Cells
picName = c.Offset(0, 2).Value
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
With OutLookMailItem
.SentOnBehalfOfName = "EMAIL NAME"
.To = c.Offset(0, 3).Value
.CC = c.Offset(0, 4).Value
.Subject = c.Offset(0, 1).Value
.Attachments.Add picName
.Attachments.Add "C:\Users\location\Pictures\My_Demo.jpg"


.HTmlbody = " "
.HTmlbody = .HTmlbody & c.Offset(0, 5).Value & "</b>"
.HTmlbody = .HTmlbody & "<br> " & c.Offset(0, 7).Value
.HTmlbody = .HTmlbody & "<br> " & c.Offset(0, 9).Value
.HTmlbody = .HTmlbody & "<br> " & c.Offset(0, 12).Value
.HTmlbody = .HTmlbody & "<br> " & c.Offset(0, 13).Value

.HTmlbody = .HTmlbody & "<br><b><font size='3'>" & c.Offset(0, 8).Value & "</font>"

.HTmlbody = .HTmlbody & "<br> <br> <br> <br> </b> Dear " & c.Offset(0, 5).Value
'Introduction
.HTmlbody = .HTmlbody & "<br><br>We would like to thank you for your interest in learning more about our Business to Business platform. Below is a link to our interactive demo. On this demo you will be able to review every aspect of the site."

.HTmlbody = .HTmlbody & "<br><br>Once you review the demo at your own pace you can then signup on the site by clicking the Signup button all without having to leave the demo!"

.HTmlbody = .HTmlbody & "<br><br>Also note, we value your feedback so if there is anything that you see or don't see that will add value to your business we want to know. Click on the Provide Feedback button, this will allow for us to continue to grow the site with you the customer mind."
.HTmlbody = .HTmlbody & "<br>"

.HTmlbody = .HTmlbody & "<br><br>"
.HTmlbody = .HTmlbody & "<IMG src=""cid:My_Demo.jpg"" width=500>"
.HTmlbody = .HTmlbody & "<br> Check it out <a href = ""http://www.eurl.com/mydemo""> MY Demo</a>"
'start

.HTmlbody = .HTmlbody & "<br></i><br>Thank you for your continued partnership through this challenging times."
.HTmlbody = .HTmlbody & "<br> <b> Service Company"

' .HTmlbody = .HTmlbody & "<br>If you would like to embed my latest video you can find it here"
'.HTmlbody = .HTmlbody & "<br> Check it out <a href = ""URL HERE""> HERE </a>"
.Display 'to display first
'.Send 'to send it in background
End With
Next c

End Sub

 

[jamesmev]

Any Help on this would be much appreciated.
1 - Getting the Loop to end when reaching the first blank
2 - Stopping the pop up

 

[GWteB]

1 - Getting the Loop to end when reaching the first blank

If you mean the first empty cell in column B, then your code will do exactly as you expect it to.

2 - Stopping the pop up

Try replacing this line
.SentOnBehalfOfName = "EMAIL NAME"
with this line

Set .SendUsingAccount = Outlook.Application.Session.Accounts(2)