Sendmail: Problem when used after a Userform

B

Bernard Foot

I have a VBA application which requires the same workbook
to be sent (using sendmail) to multiple recipients, one
at a time. (The VBA loops through a list of users,
amending the workbook before each mailing.)

The first recipient mailing works OK, but Excel crashes
when it tries to process sendmail for the second time.
This problem only arises where the sendmail loop appears
after a userform.show in the same module. I've tried
using both userform.hide and unload userform, putting in
a delay between sendmails, putting the userform.show into
a different module. The problem occurs even if I show a
userform with absolutely nothing in it, and just
terminate the form.

Any ideas?
 
B

Bernard Foot

Ron,

Your item 4 is:
========================
Because there is a bug in Outlook it is possible that you
must uncheck
"send immediately when connect" in the Outlook options.
Tools>Options>Mail Setup in the Outlook menu.
=====================

Perhaps this is not for Outlook 2000? If I go into
Tools>Options I do not see a Mail Setup choise.

I get Preferences/E-mail/E-mail options and Mail
Services, but I cannot see the "send immediately when
connect" setting.

Berni.
 
R

Ron de Bruin

Hi Bernard

I have open a Virtual PC to check it and Outlook 200 have this setting in
Tools>Options>Mail Delivery

Post your code if this is not working
 
B

Berend Botje

@ Bernard

Can you please post the script you use to send the mail? I am lookin
for such an application.

Thanks
 
B

Bernard Foot

Hi, Berend.

I assume you mean only the bit of the script that does
the e-mailing? Here it is:

======================================
For RowNo% = 2 To 100

If Worksheets("Control").Cells(RowNo%, 3).Value = ""
Then GoTo emails_done

Range("Copy_Type").Value = Worksheets("Control").Cells
(RowNo%, 4).Value
ActiveWorkbook.SendMail Recipients:=Worksheets
("Control").Cells(RowNo%, 3).Value, Subject:="RM Training
Passport: " & Mid(Range("EstName").Value, 1, 10) & " " &
Range("PassportID").Value
Next RowNo%

emails_done:

====================================================

So in the "Control" worksheet in column C from row 2
downwards is the list of e-mail addresses. in column D is
the Copy Type appropriate to the user, which must be
entered into the named cell "Copy_Type" before the .xls
is e-mailed.

The most important line is the ActiveWorkbook.Sendmail
one, of course.

Let me know if you need anything more.

Regards,

Bernard.
 
B

Bernard Foot

Ron,

I do not see "Mail Delivery" when I go into
Outlook>Tools>Options. What I get is a dialogue box with
tabs for Preferences/Mail Services/Mail
Format/Spelling/Other/Delegates. I am working on a
company PC, so maybe that function has been locked down.

Anyway, here is the code. This code experiences the
problem: if the Send_Out_Mails command is moved before
the FormInitialise.Show statement then everything works
OK.

=====================================================
Sub Process_Passport()

ErrMsg$ = ""

If Range("PassportID").Value = "" Or Range
("PassportID").Value = Range("PassID_Prompt").Value Then
ErrMsg$ = Chr$(10) & "Unique Pasport ID"
If Range("EstName").Value = "" Or Range("EstName").Value
= Range("EstName_Prompt").Value Then ErrMsg$ = ErrMsg$ +
Chr$(10) & "Establishment Name"
If Range("EstID").Value = "" Or Range("EstID").Value =
Range("EstID_Prompt").Value Then ErrMsg$ = ErrMsg$ +
Chr$(10) & "Establishment Name"

If ErrMsg$ <> "" Then
MsgBox "The following data has not been entered:" &
Chr$(10) & ErrMsg$, vbOKOnly, "INVALID DATA !!!"
Exit Sub
End If

' If Passport Type or Days not yet set up ...
If Range("Passport_Type").Value = "" Or Range
("Passport_Days").Value = "" Then
FormInitialise.Show
' Quit if the Initialise dialoge box was cancelled
If Range("Passport_Type").Value = "" Or Range
("Passport_Days").Value = "" Then Exit Sub
End If

Unload FormInitialise

Send_Out_Mail

' Get confirmation that the entries are correct
FormConfirm.Show

If Range("Confirm_Form_OK").Value = 0 Then Exit Sub

' Set Passport heading
If Range("Passport_Type").Value = 1 Then
Range("Passport_Heading").Value = Range
("Passport_Heading").Value & "(Type 1: Microsoft
Technical Courses exc. Certification)"
Else
Range("Passport_Heading").Value = Range
("Passport_Heading").Value & "(Type 2: Applications,
Citrix, Cisco, Certification)"
End If

' Set up Part No. to be displayed
If Range("Passport_Type").Value = 1 Then
If Range("Passport_Days").Value = 10 Then
PartNo$ = Range("PN_1_10").Value
Else
PartNo$ = Range("PN_1_30").Value
End If
Else
If Range("Passport_Days").Value = 10 Then
PartNo$ = Range("PN_2_10").Value
Else
PartNo$ = Range("PN_2_30").Value
End If
End If

Range("RM_Part_No").Value = "RM Part No. " & PartNo$

' Set correct number of rows in the table
If Range("Passport_Days").Value = 10 Then
Rows("18:37").Delete Shift:=xlUp
Range("A17:G17").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If

' save into a temporary file in case of a problem and
need to recover
FilePath$ = ActiveWorkbook.Path & "\"
On Error Resume Next
Kill FilePath$ & "Passport_WIP.xls"
On Error GoTo 0
ActiveWorkbook.SaveAs Filename:= _
FilePath$ & "Passport_WIP.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False

' Delete program button
ActiveSheet.Shapes("Button_Create").Delete

' Hide Comments
Application.DisplayCommentIndicator = xlNoIndicator

' Turn off row/col numbers
ActiveWindow.DisplayHeadings = False

' Sort e-mail, etc. lists to ensure no blank lines
Range("Control!C2:D100").Sort Key1:=Range("Control!C2"),
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Range("Control!E2:F100").Sort Key1:=Range("Control!E2"),
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

Range("Control!G2:G100").Sort Key1:=Range("Control!G2"),
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

' Enter Issue & Expiry Date
Range("Date_Issued_Label").Value = "Date Issued:"
Range("Issue_Date").Value = Date
Range("Expiry_Date_Label").Value = "Expiry Date:"
Range("PassportExpiry").Value = Date + Range
("Validity").Value
' Put borders around these two items
With Range("G4:G5")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
With Range("G4:G5").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("G4:G5").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("G4:G5").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("G4:G5").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Range("G4:G5").Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

' Hide Control sheet
Sheets("Control").Visible = False

' Print Hardcopies
If Range("Test_Mode").Value = 1 Or Range
("Test_Mode").Value = 2 Then GoTo hardcopy_done

' Unprotect workbook
ActiveWorkbook.Unprotect Password:="getCluedup"
ActiveSheet.Unprotect Password:="getCluedup"

' Print Customer Copy if no customer e-mail address given:
If Not Range("EstEmail").Value Like "*@*.*" Then

Range("Copy_Type").Value = "Customer Copy"
ActiveWindow.SelectedSheets.PrintOut Copies:=1,
Collate:=True

End If

For RowNo% = 2 To 100

If Worksheets("Control").Cells(RowNo%, 7).Value = ""
Then GoTo hardcopy_done

Range("Copy_Type").Value = Worksheets("Control").Cells
(RowNo%, 7).Value

' If this is a customer copy, print all pages (inc.
Notes, Ts&Cs), otherwise just print the Passport
If Range("Copy_Type").Value = "Customer Copy" Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1,
Collate:=True
Else
ActiveWindow.SelectedSheets.PrintOut From:=1,
To:=1, Copies:=1, Collate:=True
End If

Next RowNo%

hardcopy_done:
' Protect workbook
ActiveWorkbook.Protect Structure:=True, Windows:=False,
Password:="getCluedup"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True, Password:="getCluedup"

Range("B8").Select

' Create new files
For RowNo% = 2 To 100

FilePath$ = Worksheets("Control").Cells(RowNo%,
5).Value
If FilePath$ = "" Then GoTo Filing_Done
If Not FilePath$ Like "*\" Then FilePath$ = FilePath$
& "\"
Filename$ = Mid(Range("EstName").Value, 1, 10) & "_"
& Range("PassportID").Value
' Unprotect workbook
ActiveWorkbook.Unprotect Password:="getCluedup"
ActiveSheet.Unprotect Password:="getCluedup"
Range("Copy_Type").Value = Worksheets("Control").Cells
(RowNo%, 6).Value
' Protect workbook
ActiveWorkbook.Protect Structure:=True,
Windows:=False, Password:="getCluedup"
ActiveSheet.Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True, Password:="getCluedup"

ActiveWorkbook.SaveAs Filename:= _
FilePath$ & Filename$, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False

Next RowNo%

Filing_Done:

' Send E-mails
If Range("Test_Mode").Value = 1 Or Range
("Test_Mode").Value = 3 Then GoTo emails_done

' If Customer e-mail has been specified ...
If Range("EstEmail").Value Like "*@*.*" Then

' Unprotect workbook
ActiveWorkbook.Unprotect Password:="getCluedup"
ActiveSheet.Unprotect Password:="getCluedup"
' Set copy type at top right of Passport
Range("Copy_Type").Value = "Customer Copy"
' Protect workbook
ActiveWorkbook.Protect Structure:=True,
Windows:=False, Password:="getCluedup"
ActiveSheet.Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True, Password:="getCluedup"

ActiveWorkbook.SendMail Recipients:=Range
("EstEmail").Value, Subject:="RM Training Passport: " &
Mid(Range("EstName").Value, 1, 10) & " " & Range
("PassportID").Value

End If


GoTo emails_done

For RowNo% = 2 To 100

If Worksheets("Control").Cells(RowNo%, 3).Value = ""
Then GoTo emails_done

' Unprotect workbook
ActiveWorkbook.Unprotect Password:="getCluedup"
ActiveSheet.Unprotect Password:="getCluedup"
' Set copy type at top right of Passport
Range("Copy_Type").Value = Worksheets("Control").Cells
(RowNo%, 4).Value
' Protect workbook
ActiveWorkbook.Protect Structure:=True,
Windows:=False, Password:="getCluedup"
ActiveSheet.Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True, Password:="getCluedup"

ActiveWorkbook.SendMail Recipients:=Worksheets
("Control").Cells(RowNo%, 3).Value, Subject:="RM Training
Passport: " & Mid(Range("EstName").Value, 1, 10) & " " &
Range("PassportID").Value

Next RowNo%

emails_done:

End Sub

Function Valid_Email(TestText$)

Valid_Email = 0

If UCase(TestText$) Like "[A-Z0-9]*@[A-Z0-9]*.[A-Z0-9]*"
Then Valid_Email = 1

End Function

Sub Send_Out_Mail()

For RowNo% = 2 To 100

If Worksheets("Control").Cells(RowNo%, 3).Value = ""
Then GoTo emails_done

ActiveWorkbook.Unprotect Password:="getCluedup"
ActiveSheet.Unprotect Password:="getCluedup"
Range("Copy_Type").Value = Worksheets("Control").Cells
(RowNo%, 4).Value
ActiveWorkbook.Protect Structure:=True,
Windows:=False, Password:="getCluedup"
ActiveSheet.Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True, Password:="getCluedup"
ActiveWorkbook.SendMail Recipients:=Worksheets
("Control").Cells(RowNo%, 3).Value, Subject:="RM Training
Passport: " & Mid(Range("EstName").Value, 1, 10) & " " &
Range("PassportID").Value
Next RowNo%

emails_done:

End Sub
-----Original Message-----
Hi Bernard

I have open a Virtual PC to check it and Outlook 200 have this setting in
Tools>Options>Mail Delivery

Post your code if this is not working

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Bernard Foot" <[email protected]>
Click to expand...
wrote in message [email protected]...
 
B

Berend Botje

Can I get around the confirmation window?

I want to send it without the confirmation of the user being asked
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Excel VBA using Sendmail to Send to Distribution List 1
Sendmail with a named cell value as recipient 2
Problem with .sendmail 3
Issue passing data from sheet into userform 1
how to reshow userform after following a link 1
UserForm remains visible after Unload - 2003 3
Unload/Hide Userform when switching to a new Wbk 1
Userform from a Userform Problem 1

Top