No se puede agregar un archivo adjunto al correo electrónico usando VBA

Question

Tengo un problema muy extraño con este código.El propósito general es guardar los datos del usuario desde un formulario en Access a una hoja de cálculo en Excel y luego usar un cliente de correo electrónico para enviar un correo electrónico que contenga el archivo adjunto de la hoja de cálculo.El código es el siguiente

    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

Sin la línea ".AddAttachment..." El código funciona exactamente como se esperaba, menos el envío del archivo adjunto, por supuesto.Sin embargo, con esa línea, aparece un error de ejecución 91, y el depurador cita la línea "Xl.ActiveWorkbook.Save" como código problemático.Además, sin el código para modificar la hoja de cálculo de Excel, la parte simple del correo electrónico funciona, incluidos los archivos adjuntos.Si alguien puede darme una idea de por qué recibo este error, sería de gran ayuda.¡Gracias de antemano!

EDITAR:Al volver a probar el código, parece fallar constantemente en Xl.ActiveWorkbook.Save. Pensé que funcionaba antes, pero debo haberme equivocado.

Answer 1

Usted (cree que) está guardando y cerrando su libro de trabajo con:

Xl.ActiveWorkbook.Save
Xl.ActiveWorkbook.Close

pero ese no es el libro que estás usando y manipulando, que es XlBook:

Set XlBook = GetObject(MySheetPath)

Si guarda y cierra el libro de trabajo "real", XlBook:

XlBook.Save
XlBook.Close

entonces debería funcionar.

La razón por la que recibes el error en el Save llamada probablemente significa que el Xl.ActiveWorkbook El objeto no existe/es nulo o algo así.