在函数运行完成后，使用RangetoHtml函数和Excel将不会closures

基本上我创build了一个报告，然后通过电子邮件发送。 我使用Ron B的function将Excel表格粘贴到电子邮件的正文中。 发送电子邮件function完成后，excel不会破坏或closures。 当我结束它的任务，并再次运行它说，远程机器或服务器不会退出。 这可能是因为我没有明确定义对象，但我不知道如何在两个程序之间。 我试图让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下面，当你debugging它在excel结束任务后，它停在这一行：设置TempWB = Workbooks.Add（1）我知道你应该把XlApp.Workbooks.Add（1），但在Html函数的范围它不被声明为一个对象，但它是在它正在调用的函数。 我不知道下一步该做什么以及如何修复代码。 我发布这两个函数，所以你可以看到代码。 当发送电子邮件时，它会调出电子邮件并将Excel表格粘贴到电子邮件中，但Excel不会closures。

 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 

现在在htmlbody中调用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 

任何人都可以提供的帮助，肯定会受到赞赏。