我该如何解决此错误?
'Begin Email button
Sub Email_Figures_Click()
'Dims the things we need
Dim CDO_Mail As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim strSubject As String
Dim strFrom As String
Dim strTo As String
Dim strCc As String
Dim strBcc As String
Dim myRng As Range
Dim CaseRange As Integer
'To begin with, we want a clean Range, meaning nothing inside
Set myRng = Nothing
'So I am setting the cells I wish to use from the Excel Sheet Monthly Figures
Set myRng = Sheets("Monthly Figures").Range("A2,B2,A5,B5,A6,B6,A8,B8,A9,B9,A10,B10,A11,B11,A12,B12,A13,B13,A15,B15,A17,B17,A18,B18,A19,B19,A20,B20,A22,B22,A23,B23,A25,B25").SpecialCells(xlCellTypeVisible)
'Error Handling message, just incase
If myRng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
'Sets the email body title (inside the html_text)
html_text = "<html><body><h1>**HIDDEN** Monthly Figures</h1><br><br /><br><br />"
'Defaults the CaseRange to 1
CaseRange = 1
For Each Row In myRng.Rows 'For each Row
For Each Cell In Row.Cells 'And for each cell in the Row
Select Case CaseRange
'Month Title Heading
Case 1
html_text = html_text & _
"<h2>" & _
Cell.Text & _
"</h2>"
'The Month
Case 2
html_text = html_text & _
"<h2>" & _
Cell.Text & _
"</h2>"
'All other Title Headings
Case 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33
html_text = html_text & _
"<h3>" & _
Cell.Text & _
"</h3>"
'All the Black Totals
Case 4, 6, 8, 14, 20, 22, 24, 32, 34
html_text = html_text & _
"<h3>" & _
Cell.Text & _
"</h3>"
'All the Red Totals
Case 12, 18, 28, 30
html_text = html_text & _
"<h3><font color='red'>" & _
Cell.Text & _
"</font></h3>"
'All the Green Totals
Case 10, 16, 26
html_text = html_text & _
"<h3><font color='green'>" & _
Cell.Text & _
"</font></h3>"
End Select
Next Cell 'Jump to the next cell and repeat the the process
Next Row ' Jump to next Row and repeat the process
'Close our html & body tags before adding to email
html_text = html_text & "</body></html>"
'error handling
Set CDO_Mail = CreateObject("CDO.Message")
On Error GoTo Error_Handling
'Sets our SMTP settings so we can send emails
Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
'Settings for sending the email
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "**HIDDEN**"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "**HIDDEN**"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "**HIDDEN**"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Update
End With
'Sets the config
With CDO_Mail
Set .Configuration = CDO_Config
End With
'Defines Email Attributes
CDO_Mail.Subject = "**HIDDEN** Monthly Figures"
CDO_Mail.From = "**HIDDEN**"
CDO_Mail.To = "**HIDDEN**"
CDO_Mail.HTMLBody = html_text
CDO_Mail.CC = ""
CDO_Mail.BCC = ""
'Sends the email
CDO_Mail.Send
'Error handling and email sent successfully confirmation
Error_Handling:
If Err.Description <> "" Then MsgBox Err.Description Else MsgBox "Message sent successfully"
'End the button
End Sub
有时会发生此错误。