Outlook邮件“数组索引超出范围”

时间:2019-10-16 12:08:18

标签: excel vba

我的Outlook邮件有问题。我正在通过Excel VBA创建HTML邮件,并且显示正确。当用户单击“发送”时,表示发送正确。但是,如果用户(在Outlook 2016上)尝试添加附件,则会得到提示“数组索引超出范围”(即使在创建邮件后Excel已关闭),所以我认为这是Outlook的问题,而不是Excel的问题。在Outlook 2010中不会发生这种情况。

我注意到,当用户将消息类型更改为RTF时,可以添加附件(但是HTML格式对我来说非常重要,因为我想在正文中发送表格)。

我已经搜索了Stack和其他站点,但是在该提示下找到的所有内容都是在代码运行时在Excel中发生的。在此先感谢:)


有人要求我提供代码(我认为这并不重要,但也许我错了;))。

Sub WysyłanieMaila(Treść As String, Temat As String, Adresat As String, DW As String, Załącznik As String)

Dim Wyświetlanie As Boolean
Dim Wyślij As Boolean
Dim OutApp As Object
Dim OutMail As Object

Wyświetlanie = True
Wyślij = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

On Error Resume Next
With OutMail
    .BodyFormat = 3
    If Wyświetlanie Then .Display
    .To = Adresat 
    .CC = DW
    .Subject = Temat
    .Body = Treść
    .Attachments.Add Załącznik
    If Wyślij Then
        .Send
    Else
        .Display
    End If
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Function TreśćHTMLDoMaila(WierszMin As Long, WierszMax As Long) As String

Dim i As Long
Dim j As Integer
Dim KolumnaPoczątek As Integer
Dim KolumnaKoniec As Integer

KolumnaPoczątek = 1
KolumnaKoniec = 18

TreśćHTMLDoMaila = "<table border=1 cellpadding=5 style=""border-collapse:collapse""><tr>"

For j = KolumnaPoczątek To KolumnaKoniec
    If Not j = 4 And Not j = 14 And Not j = 15 And Not j = 17 Then TreśćHTMLDoMaila = TreśćHTMLDoMaila & "<td><b><font face=""Calibri"" size=""2"">" & Arkusz1.Cells(1, j).Value & "</font></b></td>"
Next j
TreśćHTMLDoMaila = TreśćHTMLDoMaila & "</tr>"

For i = WierszMin To WierszMax
    If Arkusz1.Cells(i, 25).Value = "Nierozliczone" Then
        TreśćHTMLDoMaila = TreśćHTMLDoMaila & "<tr>"
        For j = KolumnaPoczątek To KolumnaKoniec
            If Not j = 4 And Not j = 14 And Not j = 15 And Not j = 17 Then TreśćHTMLDoMaila = TreśćHTMLDoMaila & "<td><font face=""Calibri"" size=""2"">" & Arkusz1.Cells(i, j).Value & "</font></td>"
        Next j
        TreśćHTMLDoMaila = TreśćHTMLDoMaila & "</tr>"
    End If
Next i

TreśćHTMLDoMaila = TreśćHTMLDoMaila & "</table>"

End Function

2 个答案:

答案 0 :(得分:0)

您需要通过在调试器下运行代码来查找哪一行代码给出错误。有关更多信息,请参见Debugging。但是我认为问题出在TreśćHTMLDoMaila函数中。

Attachments.Add方法在Attachments集合中创建一个新附件。附件的来源可以是文件(由具有文件名的完整文件系统路径表示)或构成附件的Outlook项目。因此,您只需要确保文件路径正确即可。

答案 1 :(得分:0)

好吧,不是这种情况(正如我之前提到的,代码运行时没有问题),但是删除.Attachment.Add行解决了我计算机上的问题。我已经问过我的同事,等待答复。