VBA для каждого в массиве несоответствие типов

Question

Я использовал следующий код для отправки электронных писем, но я получаю «ошибку времени выполнения 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

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 становится двумерным массивом и, следовательно, он становится Variant/Variant(1 to 2, 1 to 1)

Вышеуказанное можно проверить с помощью Watch на arr в VBA.

По этой причине ваш код работает, когда у вас более одной ячейки.

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" поймал эти ошибки для вас