Userform help needed

  • Thread starter Thread starter Corey G
  • Start date Start date
C

Corey G

Hi,

I have a macro that sends emails. The send email feature is in a
loop
so it could possibly send out multiple emails to multiple addresses.
Before the email is sent, I have a Userform that pops up and tells
you
what information you are about tho send. I hit Continue (which does
"Unload Me") and the email is sent.


Let's say there are two emails that are going to go out though. The
form pops up, the email is sent, and then.....


nothing seems to happen.


As soon as I click on Excel though, the next dialog box pops up (with
the info that will be sent in the second email) and everything goes
out fine. So, I'm not sure why the focus for the second user form is
lost? I've tried a few things, but can't figure it out.


I bring up the form like this:


UserForm1.TextBox1.MultiLine = True
formbody = "To: " & contactArray(z) &
vbCrLf & "Subject: " & strsub & vbCrLf & vbCrLf & formbody
UserForm1.TextBox1.Value = formbody
UserForm1.Show


Thanks in advance for any advice/help with this.
 
Here is the entire subroutine as most of this routine is a big loop:


Sub Create_Emails()


MyDate = Date
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
newcontact = False
alldone = False
For z = 0 To iLastColumn - 1
formbody = "Information being sent" + vbCrLf + vbCrLf




' strto = contactArray(z)
' strto = ""
strbcc = ""
strsub = "######### - ETA for " + Clientname + " reports -
" + MyDate
strbody = "<html><head><title>Reporting ETA</title></
head><body topmargin=""0"" leftmargin=""0"" rightmargin=""0""
bottommargin=""0"" marginwidth=""0"" marginheight=""0"">" & _
"<FONT color=#000000 face= verdana, arial
size=3><STRONG>Reporting Status - " + MyDate + "</font></
strong><br><br>" & vbNewLine & _
"<TABLE style=""WIDTH: 370pt; BORDER-COLLAPSE:
collapse"" cellSpacing=0 cellPadding=0 width=493 border=0>" & _
"<TR style=""HEIGHT: 12.75pt"" height=17>" & _
"<TD style=""BORDER-RIGHT: windowtext 0.5pt solid;
BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt
solid; WIDTH: 107pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT:
12.75pt; BACKGROUND-COLOR: black"" width=102 height=17><FONT
color=#ffffff face= verdana, arial size=2><STRONG>System</STRONG></
FONT></TD><TD style=""BORDER-RIGHT: windowtext 0.5pt solid; BORDER-
TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 149pt;
BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: black""
width=199><FONT face= verdana, arial color=#ffffff
size=2><STRONG>Status</STRONG></FONT></TD><TD style=""BORDER-RIGHT:
windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-
LEFT: windowtext; WIDTH: 114pt; BORDER-BOTTOM: windowtext 0.5pt solid;
BACKGROUND-COLOR: black"" width=192><STRONG><FONT face= verdana, arial
color=#ffffff size=2>ETA</FONT></STRONG></TD></TR>"

strtest = strbody + "</table></body></html>"

Do While newcontact = False And z < iLastColumn
If contactArray(z) = contactArray(z + 1) Then
strbody = strbody & htmlString(z)
formbody = formbody & formbodyArray(z)
Else
strbody = strbody & htmlString(z)
formbody = formbody & formbodyArray(z)
' Call Send_Email
strbody = strbody & "</strong></
table><br><br><FONT color=#000000 face= verdana, arial size=1>###</
body></html>"
strto = contactArray(z)

If strbody <> strtest Then
'
********************************************************************************************

UserForm1.TextBox1.MultiLine = True
formbody = "To: " & contactArray(z) &
vbCrLf & "Subject: " & strsub & vbCrLf & vbCrLf & formbody
UserForm1.TextBox1.Value = formbody

UserForm1.Show

'
********************************************************************************************


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

With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.HTMLBody = strbody
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing

End If

strbody = "ETA for reporting" &
vbNewLine & _
"<html><head><title>Reporting ETA</
title></head><body topmargin=""0"" leftmargin=""0"" rightmargin=""0""
bottommargin=""0"" marginwidth=""0"" marginheight=""0""><TABLE
style=""WIDTH: 370pt; BORDER-COLLAPSE: collapse"" cellSpacing=0
cellPadding=0 width=493 border=0>"


newcontact = True

End If
If z + 1 = iLastColumn Then
alldone = True
z = z + 1
End If
z = z + 1

Loop
z = z - 1
newcontact = False
Next z
If alldone = True Then
z = z - 1
strbody = strbody & htmlString(z)
formbody = formbody & formbodyArray(z)
' Call Send_Email

strbody = strbody & "</strong></
table><br><br><FONT color=#000000 face= verdana, arial size=1>######</
body></html>"
strto = contactArray(z)

If strbody <> strtest Then

'
********************************************************************************************

UserForm1.TextBox1.MultiLine = True
formbody = "To: " & contactArray(z) &
vbCrLf & "Subject: " & strsub & vbCrLf & vbCrLf & formbody
UserForm1.TextBox1.Value = formbody
UserForm1.Show



'
********************************************************************************************

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

With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.HTMLBody = strbody
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
End If

End If

End Sub
 
Back
Top