Excel VBA代码:系统错误(服务器抛出异常)

时间:2018-06-06 12:16:16

标签: excel vba lotus-notes

我对VBA编码有些新意。我有一个excel文件,其中有一个用户列表,通过勾选相关的复选框,自动向其发送电子邮件请求验证。

我设法得到以下代码,工作正常。然而,最近,代码已经开始生成以下错误消息,原因是“系统错误& H80010105(-2147417851)”:服务器引发异常。

Sub SendEmailUsingCOM()

'This macro will open an email session with Lotus Notes,
'add text from the sheet "email" to the body of the email,
'give the email a name and place an email adress.

 'Set up the objects requiered for automation into lotus notes
  Dim Maildb As Object 'The mail database
  Dim UserName As String 'The current users notes name
  Dim MailDbName As String 'The current users notes mail database name
  Dim AttachME As Object 'the attachment richtextfile object
  Dim vToList     As Variant, vCCList As Variant, vBody As Variant
  Dim MailDoc As Object 'the mail document itself
  Dim Session As Object 'The notes session
  Dim EmbedObj As Object 'The embedded object attachment)

  'Open and locate current lotus Notes user
   Set Session = CreateObject("Notes.NotesSession")

   UserName = Session.UserName
   MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

  Set Maildb = Session.GetDatabase("", MailDbName) 'already open for mail
  If Maildb.IsOpen = True Then
  Else
  Maildb.OpenMail
  End If
  'Set up the new mail document
   Set MailDoc = Maildb.CreateDocument
   vToList = Application.Transpose(Range("S1").Resize(Range("S" & Rows.Count).End(xlUp).Row).Value)
   vCCList = Application.Transpose(Range("B1").Resize(Range("B" & Rows.Count).End(xlUp).Row).Value)
   MailDoc.Form = "Memo"

   MailDoc.Subject = "Demande de Validation"
   MailDoc.Body = [F1].Value
   MailDoc.SavemessageOnSend = True
   MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
   On Error GoTo errorhandler1
   MailDoc.Send 0, vToList

   MsgBox ("Les validations ont été demandées")

   Set MailDoc = Nothing
   Set Maildb = Nothing
   Set Session = Nothing
   Set AttachME = Nothing
   Set EmbedObj1 = Nothing

   errorhandler1:

   Set MailDoc = Nothing
   Set Maildb = Nothing
   Set Session = Nothing
   Set AttachME = Nothing
   Set EmbedObj1 = Nothing

  End Sub

许多用户使用相同的脚本具有不同的Excel电子表格,并且此错误仅发生在其中一个中。此外,如果任何其他用户尝试发送电子邮件(再次,勾选任何带有验证器名称的复选框,以便向此人发送电子邮件),则不会弹出任何错误消息。你能帮帮我解决这个错误吗?

非常感谢。

米格尔

0 个答案:

没有答案