Код Excel VBA: системная ошибка (сервер выдал исключение) - PullRequest
0 голосов
/ 06 июня 2018

Я немного новичок в кодировании 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 стот же сценарий, и эта ошибка возникает только с одним из них.Кроме того, если какой-либо другой пользователь пытается отправить электронное письмо (опять же, отметив галочкой любой флажок с именем валидатора, чтобы отправить электронное письмо этому человеку), сообщение об ошибке не появляется.Не могли бы вы помочь мне с этой ошибкой?

Большое спасибо.

Мигель

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...