D
danny
all,
i use the following code to gather email addresses and then email a
worksheet to the gathered addressees. this routine works great in debug
mode. when i attempt to execute without the debugger it fails miserably.
any ideas?
thanks in advance for your help,
danny
Sub SendActiveWorkSheet()
Dim strEmailTo() As String
Dim strSubject As String
Dim strPrompt As String
Dim strWorksheetIndex As String
Dim intCounter As Integer
Dim intEmailCount As Integer
Dim intAnswer As Integer
intCounter = 2
intEmailCount = 0
strSubject = "EOM Spreadsheet/Report"
On Error GoTo ErrorExit
strWorksheetIndex = ActiveSheet.Name
intAnswer = MsgBox("You are about to email " & strWorksheetIndex & "
worksheet..." & vbCrLf & _
"Is this correct?", vbYesNo + vbQuestion, "Emailing " &
strWorksheetIndex)
If intAnswer = vbNo Then Exit Sub
Worksheets("Email Addresses").Activate
Cells(intCounter, 1).Select
Do While Cells(intCounter, 1) <> ""
intEmailCount = intCounter - 1
ReDim Preserve strEmailTo(1 To intEmailCount)
strEmailTo(intEmailCount) = Cells(intCounter, 1)
strPrompt = strPrompt & Cells(intCounter, 1) & vbCrLf
intCounter = intCounter + 1
Loop
If intEmailCount < 1 Then GoTo ErrorExit
intAnswer = MsgBox(strWorksheetIndex & "will be sent to: " & vbCrLf &
strPrompt & "Is this correct?", vbYesNo + vbQuestion, "Email Addresses")
If intAnswer = vbNo Then Exit Sub
ThisWorkbook.Sheets(strWorksheetIndex).Copy
With ActiveWorkbook
.SendMail Recipients:=Array(strEmailTo), Subject:=strSubject
.Close SaveChanges:=False
End With
Exit Sub
ErrorExit:
MsgBox "Warning! Email has not been sent!", vbCritical
End Sub
i use the following code to gather email addresses and then email a
worksheet to the gathered addressees. this routine works great in debug
mode. when i attempt to execute without the debugger it fails miserably.
any ideas?
thanks in advance for your help,
danny
Sub SendActiveWorkSheet()
Dim strEmailTo() As String
Dim strSubject As String
Dim strPrompt As String
Dim strWorksheetIndex As String
Dim intCounter As Integer
Dim intEmailCount As Integer
Dim intAnswer As Integer
intCounter = 2
intEmailCount = 0
strSubject = "EOM Spreadsheet/Report"
On Error GoTo ErrorExit
strWorksheetIndex = ActiveSheet.Name
intAnswer = MsgBox("You are about to email " & strWorksheetIndex & "
worksheet..." & vbCrLf & _
"Is this correct?", vbYesNo + vbQuestion, "Emailing " &
strWorksheetIndex)
If intAnswer = vbNo Then Exit Sub
Worksheets("Email Addresses").Activate
Cells(intCounter, 1).Select
Do While Cells(intCounter, 1) <> ""
intEmailCount = intCounter - 1
ReDim Preserve strEmailTo(1 To intEmailCount)
strEmailTo(intEmailCount) = Cells(intCounter, 1)
strPrompt = strPrompt & Cells(intCounter, 1) & vbCrLf
intCounter = intCounter + 1
Loop
If intEmailCount < 1 Then GoTo ErrorExit
intAnswer = MsgBox(strWorksheetIndex & "will be sent to: " & vbCrLf &
strPrompt & "Is this correct?", vbYesNo + vbQuestion, "Email Addresses")
If intAnswer = vbNo Then Exit Sub
ThisWorkbook.Sheets(strWorksheetIndex).Copy
With ActiveWorkbook
.SendMail Recipients:=Array(strEmailTo), Subject:=strSubject
.Close SaveChanges:=False
End With
Exit Sub
ErrorExit:
MsgBox "Warning! Email has not been sent!", vbCritical
End Sub