基本上我创建了一个报告，然后通过电子邮件发送。我使用Ron B的功能将excel表格粘贴到电子邮件正文中。发送电子邮件功能完成后，excel不会销毁或关闭。当我结束任务并再次运行它时，它说远程机器或服务器不会退出。这可能是因为我没有明确定义对象，但我不知道如何在两个程序之间进行。我尝试将xlApp公开，但那不起作用。我甚至尝试将它添加到rangetohtml函数中，但是在它说rng.copy的地方，它说有一个对象是必需的。我尝试添加xlApp.rng.copy或wb.rng.copy或ws.rng.copy。所以我有下面的html范围复制rng。这被添加到临时工作簿并复制到电子邮件中。它从一个函数调用到另一个函数，我无法弄清楚如何在完成时销毁excel会话。
Set rng = xlApp.Selection.SpecialCells(xlCellTypeVisible)
Set rng = wb.Sheets(2).Range("A:U").SpecialCells(xlCellTypeVisible)
Set rng2 = xlApp.Selection.SpecialCells(xlCellTypeVisible)
Set rng2 = wb.Sheets(1).Range("A:U").SpecialCells(xlCellTypeVisible)
现在html的范围说RangetoHtml（范围为Rng）然后在底部说 rng.copy 在你的excel上结束任务后调试它时，它停在这一行： 设置TempWB = Workbooks.Add（1） 我知道你应该放置XlApp.Workbooks.Add（1）但是在Html函数的范围内它不被声明为一个对象，但它在它调用的函数中。我不知道接下来该做什么以及如何修复代码。我发布了这两个函数，所以你可以看到代码。当发送电子邮件发生时，它会显示电子邮件并将Excel工作表粘贴到电子邮件中，但excel不会关闭。
Public Function sendEmailorbetechprealert()
Dim appOutLook As Outlook.Application
Dim Items As Outlook.Items
Dim Item As Object
Dim strPath As String
Dim strFilter As String
Dim strFile As String
Dim rng As Range
Dim rng2 As Range
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim MyFileName As String
Dim bfile As String
Dim Cell As Range
bfile = "S:\_Reports\Orbotech\Orbotech - Open Deliveries Pre-Alert\Orbotech - Open Deliveries Pre-Alert - "
MyFileName = bfile & Format(Date, "mm-dd-yyyy") & ".xls"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number > 0 Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0
Set wb = xlApp.Workbooks.Open(MyFileName)
Set ws = wb.Sheets(1)
ws.Activate
Set rng = Nothing
Set rng2 = Nothing
On Error Resume Next
Set rng = xlApp.Selection.SpecialCells(xlCellTypeVisible)
Set rng = wb.Sheets(2).Range("A:U").SpecialCells(xlCellTypeVisible)
Set rng2 = xlApp.Selection.SpecialCells(xlCellTypeVisible)
Set rng2 = wb.Sheets(1).Range("A:U").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
Set appOutLook = Nothing
Set Items = Nothing
End If
If rng2 Is Nothing Then
Set appOutLook = Nothing
Set Items = Nothing
Exit Function
End If
strPath = "S:\_Reports\Orbotech\Orbotech - Open Deliveries Pre-Alert\" 'Edit to your path
strFilter = "*.xls"
strFile = Dir(strPath & strFilter)
'For Each Cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
If strFile <> "" Then
Set appOutLook = CreateObject("Outlook.Application")
Set Items = Outlook.Application.ActiveExplorer.CurrentFolder.Items
Set Item = Items.Add("IPM.Note.iCracked")
With Item
.To = ""
'.CC =
''.bcc = ""
.Subject = "Orbotech Open Deliveries Report Pre-Alert"
.htmlBody = "This is the Open Deliveries Report. Please open the attachment. These lines are what have been inbound." & RangetoHTML(rng) & "This is what is still due" & RangetoHTML(rng2)
.Attachments.Add (strPath & strFile)
'.Send
Item.Display 'Used during testing without sending (Comment out
.Send if using this line)
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
DoEvents
End With
Else
MsgBox "No file matching please re run Orbotech Report"
Exit Function 'This line only required if more code past End If
End If
'Next Cell
DoEvents
On Error GoTo 0
wb.CheckCompatibility = False
wb.Save
wb.CheckCompatibility = True
xlApp.Quit
Set rng = Nothing
Set rng2 = Nothing
Set wb = Nothing
Set ws = Nothing
Set xlApp = Nothing
Exit Function
End Function
现在在html体中，它调用RangetoHtml（rng）将其粘贴到电子邮件中。他是rangetohtml函数：
Public Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
'xlApp.Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
fileName:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.CheckCompatibility = False
TempWB.Save
TempWB.CheckCompatibility = True
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
任何人都可以提供的帮助肯定会受到赞赏。