لا يمكن إضافة مرفق إلى البريد الإلكتروني باستخدام VBA

Question

أواجه مشكلة غريبة جدًا مع هذا الرمز.الغرض العام هو حفظ بيانات المستخدم من نموذج في 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 اعتقدت أنه يعمل من قبل، ولكن لا بد أنني كنت مخطئًا

Answer 1

أنت (تعتقد أنك) تقوم بحفظ المصنف الخاص بك وإغلاقه باستخدام:

Xl.ActiveWorkbook.Save
Xl.ActiveWorkbook.Close

ولكن هذا ليس المصنف الذي تستخدمه وتتلاعب به، وهو XlBook:

Set XlBook = GetObject(MySheetPath)

إذا قمت بحفظ المصنف "الحقيقي" وإغلاقه، XlBook:

XlBook.Save
XlBook.Close

ثم يجب أن تعمل.

سبب حصولك على الخطأ في Save ربما يعني الاتصال أن Xl.ActiveWorkbook الكائن غير موجود/خالي أو شيء من هذا القبيل.