在Outlook VBA中下标超出范围错误

下面的代码从Excel工作表中获取值并通过Outlook发送邮件。 代码在Outlook VBA中完成:Option Explicit

Sub Sendmail() Dim olItem As Outlook.MailItem Dim xlApp As Excel.Application Dim oApp As Outlook.Application Dim xlBook As Excel.Workbook Dim xlSht As Excel.Worksheet Dim WSTbl As Excel.Worksheet Dim sPath As String Dim iRow As Long, I As Long, J As Long, K As Long Dim Signature As String Dim sBody As String, sTable As String Dim oWord As Word.Editor Dim Range2 As Word.Range sPath = "***\mail.xlsx" ' // Excel - Outlook Set xlApp = CreateObject("Excel.application") Set oApp = CreateObject("Outlook.Application") oApp.ActiveWindow '---> Disable Events With xlApp .EnableEvents = False .DisplayAlerts = False .ScreenUpdating = False End With ' // Workbook Set xlBook = xlApp.Workbooks.Open(sPath) MsgBox xlBook.FullName ' // Sheet Set xlSht = xlBook.Sheets("Sheet1") Set WSTbl = xlBook.Sheets("Table") iRow = xlSht.Range("D" & xlSht.Rows.Count).End(xlUp).Row ' // Create e-mail Item Set olItem = oApp.CreateItem(olMailItem) Signature = "" 'xlSht.Range("E2") '---> Start Process With olItem '---> Fill Address .To = Join(xlApp.Transpose(xlSht.Range("A2", xlSht.Range("A9999").End(xlUp))), ";") .CC = Join(xlApp.Transpose(xlSht.Range("B2", xlSht.Range("B9999").End(xlUp))), ";") '---> Fill Subject .Subject = xlSht.Range("C2") '---> Start Filling HTMLBody .BodyFormat = olFormatHTML .HTMLBody = "<html><body><pre><font face=Calibri size=3>" .Display '---> Fill The Body For I = 2 To iRow If InStr(1, xlSht.Cells(I, "D"), "http") <> 0 Then '---> Special handling for url sBody = "<a href=" & xlSht.Cells(I, "D") & ">" & xlSht.Cells(I, "D") & "</a>" & "<br>" ElseIf InStr(1, LCase(xlSht.Cells(I, "D")), "[table]") <> 0 Then '---> special handling for table WSTbl.ListObjects(Table1).Range.Copy Set Range2 = .GetInspector.WordEditor.Content Range2.Collapse Direction:=wdCollapseEnd Range2.Paste Else sBody = xlSht.Cells(I, "D") & "<br>" End If '---> Apply to HTMLbody DoEvents .HTMLBody = .HTMLBody & sBody sBody = "" Next I DoEvents .HTMLBody = .HTMLBody & "</font></pre></body></html>" '.Save or .send End With '---> Enable Events With xlApp .EnableEvents = True .DisplayAlerts = True .ScreenUpdating = True End With '---> Clean Variables Set oApp = Nothing Set xlBook = Nothing Set xlSht = Nothing Set olItem = Nothing End Sub 

错误发生在此行“WSTbl.ListObjects(Table1).Range.Copy”

该代码正确加载到,抄送,主题值从Excel工作表。 对于邮件正文,代码在列D中遍历,当它到达要从下一个选项卡获取表的错误发生的行表。

如何在Excel表格中处理dynamic表格。

请注意这是一张dynamic表格。