Невозможно добавить вложение к электронной почте с помощью VBA
-
02-01-2020 - |
Вопрос
У меня очень странная проблема с этим кодом.Общая цель — сохранить пользовательские данные из формы в Access в электронной таблице в Excel, а затем использовать почтовый клиент для отправки электронного письма, содержащего вложение электронной таблицы.Код выглядит следующим образом
Private Sub Send_Email_Click()
Dim MySheetPath As String
Dim Xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
' Tell it location of actual Excel file
MySheetPath = "\\SERVER\Users\Public\Documents\WORK ORDERS\Blank Work Order.xlsx"
'Open Excel and the workbook
Set Xl = CreateObject("Excel.Application")
Set XlBook = GetObject(MySheetPath)
'Make sure excel is visible on the screen
Xl.Visible = True
XlBook.Windows(1).Visible = True
'Define the sheet in the Workbook as XlSheet
Set XlSheet = XlBook.Worksheets(1)
'Insert values in the excel sheet starting at specified cell
XlSheet.Range("B6") = Jobnameonform.Value
XlSheet.Range("C7") = Companynameonform.Value
XlSheet.Range("C8") = Employeename.Value
XlSheet.Range("H7") = Jobnumberonform.Value
Xl.ActiveWorkbook.Save
Xl.ActiveWorkbook.Close
Xl.Quit
'in case something goes wrong
Set Xl = Nothing
Set XlBook = Nothing
Set XlSheet = Nothing
Dim cdomsg
Set cdomsg = CreateObject("CDO.message")
With cdomsg.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "matthewfeeney6@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "REDACTED"
.Update
End With
' build email parts
With cdomsg
.To = "matthewfeeney6@gmail.com"
.From = "matthewfeeney6@gmail.com"
.Subject = "Test email"
.TextBody = "Did you get the attachment?"
.AddAttachment "\\SERVER\Users\Public\Documents\WORK ORDERS\Blank Work Order.xlsx"
.Send
End With
Set cdomsg = Nothing
MsgBox "Completed"
End Sub
Без строки «.AddAttachment...» Код работает точно так, как задумано, за исключением, конечно, отправки вложения.Однако в этой строке я получаю ошибку времени выполнения 91, при этом отладчик называет строку «Xl.ActiveWorkbook.Save» проблемным кодом.Кроме того, без кода для изменения таблицы Excel простая часть электронной почты работает, включая вложения.Если кто-нибудь может объяснить, почему я получаю эту ошибку, это было бы очень полезно.Заранее спасибо!
РЕДАКТИРОВАТЬ:При повторном тестировании кода кажется, что он постоянно вылетает в Xl.ActiveWorkbook.Save. Я думал, что раньше это работало, но, должно быть, я ошибался.
Решение
Вы (думаете, что) сохраняете и закрываете свою книгу с помощью:
Xl.ActiveWorkbook.Save
Xl.ActiveWorkbook.Close
но это не та книга, которую вы используете и манипулируете ею, а именно XlBook
:
Set XlBook = GetObject(MySheetPath)
Если вы сохраните и закроете «настоящую» книгу, XlBook
:
XlBook.Save
XlBook.Close
тогда это должно сработать.
Причина, по которой вы получаете сообщение об ошибке Save
звонок, вероятно, означает, что Xl.ActiveWorkbook
объект не существует/ имеет значение NULL или что-то в этом роде.