VBA从工作表发送邮件

Sub 从工作表发送邮件()
Dim objcdo As New ado.Message
Dim 正文 As String
Dim 收件人 As String
Dim smsg As String
If MsgBox("." & vbCr & "可以吗?", vbYesNo) = vbNo Then Exit Sub
On Error GoTo 错误处理
收件人 = Range("收件人地址") & "先生(女士)<" & WorksheetFunction.VLookup(Range("目的地"), Range("收件人一览表"), 2, False) & ">"
正文 = Replace(Range("正文"), vbLf, vbCrLf)
With objcdo
    With .Configuration.Fields
        .Item(cdoSendUsingMethod) = cdoSendUsingPort
        .Item(cdoSMTPServer) = Range("smtp").Value
        .Item(cdoSMTPServerPort) = Range("接口").Value
        .Item(cdoSMTPConnectionTimeout) = 60
        .Item(cdoSMTPAuthenticate) = "shift-jis"
        .Update
    End With
    .MimeFormatted = True
    .form = Range("发件人").Value
    .To = 收件人
    .Subject = Range("主题").Value
    .TextBody = 正文
    .TextBodyPart.Charset = "shift-jis"
    .Send
End With
Exit Sub
错误处理:
smsg = "错误: " & Err.Number & vbCrLf & Err.Description
msgboxsmsg , vbOKOnly, "发送错误"
End Sub