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

没有线＆＃34; .AddAttachment ...＆＃34;代码完全按预期工作，当然减去发送附件。但是，使用该行，我得到一个运行时错误91，调试器引用了行＆＃34; Xl.ActiveWorkbook.Save＆＃34;作为有问题的代码。此外，如果没有修改Excel电子表格的代码，简单的电子邮件部分就可以工作，包括附件。如果有人能够提供关于我为什么会收到此错误的见解，那将非常有帮助。提前谢谢！

编辑：重新测试代码，它似乎一直在Xl.ActiveWorkbook崩溃。我以前觉得它有用，但我一定是弄错了

Answer 1

您（认为您）正在使用以下方式保存并关闭工作簿：

Xl.ActiveWorkbook.Save
Xl.ActiveWorkbook.Close

但这不是您正在使用和操作的工作簿，即XlBook：

Set XlBook = GetObject(MySheetPath)

如果保存并关闭“真实”工作簿，XlBook：

XlBook.Save
XlBook.Close

然后它应该工作。

您在Save调用时收到错误的原因可能意味着Xl.ActiveWorkbook对象不存在/为null或其他内容。

无法使用VBA向电子邮件添加附件

1 个答案: