Question

我一直在使用以下代码发送电子邮件，但是当M列中只有一个值时，我收到“运行时错误13”。

如果我具有两个以上的值，它将很好地工作。有什么帮助吗？

Sub testDemo()
    Dim outlookApp As Object
    Dim objMail As Object
    Dim Region
    Dim rng As Range
    Dim Mailaddr As String
    Dim MyRange As String
    Dim arr As Variant
    Dim lastrow As Long
    Dim lastrow2 As Long


     ' Create email
    Set outlookApp = CreateObject("Outlook.Application")

    ' Update with your sheet reference
    With Sheets("Escalate")

    lastrow = Range("A65536").End(xlUp).Row
    lastrow2 = Range("M65536").End(xlUp).Row
    Set rng = .Range("A1:I" & lastrow)

    End With

    arr = Range("M2:M" & lastrow2).Value


    For Each Region In arr

    myrangename = Worksheets("email").Range("C2:D200")
    Mailaddr = WorksheetFunction.VLookup(Region, myrangename, 2, False)

    On Error Resume Next


    With outlookApp.CreateItem(0)
            ' Add table to Email body
            .SentOnBehalfOfName = "script Tracking"
            .cc = "Pearson.S@cambridgeenglish.org; Tracking.S@cambridgeenglish.org"
            .HTMLBody = "Dear Team," & "<br><br>" & _
            "blahblah  " & "<br><br>" & _
            GenerateHTMLTable(rng, CStr(Region), True) & "<br><br>" & _
            "Many thanks in advance " & "<br><br>" & _
            "Kind regards "

            .To = Mailaddr
            .Subject = "Region " & Region & " Outstanding scripts -  " & Range("L1")
            .Display

        End With
skip:

    Next Region


End Sub

Public Function GenerateHTMLTable(srcData As Range, Region As String, Optional FirstRowAsHeaders As Boolean = True) As String
    Dim InputData As Variant, HeaderData As Variant
    Dim HTMLTable As String
    Dim i As Long



    ' Declare constants of table element
    Const HTMLTableHeader As String = "<table>"
    Const HTMLTableFooter As String = "</table>"

    ' Update with your sheet reference
    If FirstRowAsHeaders = True Then
        HeaderData = Application.Transpose(Application.Transpose(srcData.Rows(1).Value2))
        InputData = Range(srcData.Rows(2), srcData.Rows(srcData.Rows.Count)).Value2
        ' Add Headers to table
        HTMLTable = "<tr><th>" & Join(HeaderData, "</th><th>") & "</th></tr>"


    End If

    ' Loop through each row of data and add selected region to table output
        For i = LBound(InputData, 1) To UBound(InputData, 1)
        ' Test Region against chosen option
        If Region = InputData(i, 9) Then
            ' Add row to table for output in email
            HTMLTable = HTMLTable & "<tr><td>" & Join(Application.Index(InputData, i, 0), "</td><td>") & "</td></tr>"


        End If


Next i


    GenerateHTMLTable = HTMLTableHeader & HTMLTable & HTMLTableFooter

End Function

enter image description here

Answer 1

这将更好地解释

Sub Sample()
    Dim arr

    lastrow2 = 2

    arr = Range("M2:M" & lastrow2).Value

    lastrow2 = 3

    arr = Range("M2:M" & lastrow2).Value
End Sub

当lastrow2 = 2时，arr仅保留一个单元格值，因此它变为Variant/(String/Double...etc depending on the value in cell M2)

当lastrow2 > 2时，arr变成2D数组，因此它变成Variant/Variant(1 to 2, 1 to 1)

可以使用VBA中Watch上的arr验证以上内容。

这就是当您有多个单元格时代码可以工作的原因。

Answer 2

由于它不是集合或数组，所以它是一个值-您可以在运行IsArray(arr)之前通过检查For Each进行测试

有几种方法可以解决此问题，但是最快的方法是在If Not IsArray(Arr) Then Arr = Array(Arr)之前加入For Each行，以将其转换为1元素数组。

要考虑的其他要点：

您的On Error Resume Next的目的是什么？
您的skip:标签的目的是什么？
未定义变量myrangename-考虑在模块顶部添加Option Explicit，以便“调试>编译VBA项目”将为您捕获这些错误

VBA每个阵列类型不匹配

2 个答案:

要考虑的其他要点：