Блог

Я использовал следующий код для отправки электронных писем, но я получаю «ошибка времени выполнения 13», когда в столбце M. только одно значение.

Это работает нормально, если у меня более двух значений. Любая помощь, пожалуйста?

 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" amp; lastrow)

    End With

    arr = Range("M2:M" amp; 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," amp; "<br><br>" amp; _
            "blahblah  " amp; "<br><br>" amp; _
            GenerateHTMLTable(rng, CStr(Region), True) amp; "<br><br>" amp; _
            "Many thanks in advance " amp; "<br><br>" amp; _
            "Kind regards "

            .To = Mailaddr
            .Subject = "Region " amp; Region amp; " Outstanding scripts -  " amp; 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>" amp; Join(HeaderData, "</th><th>") amp; "</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 amp; "<tr><td>" amp; Join(Application.Index(InputData, i, 0), "</td><td>") amp; "</td></tr>"


        End If


Next i


    GenerateHTMLTable = HTMLTableHeader amp; HTMLTable amp; HTMLTableFooter

End Function
  

Это объяснит это лучше

 Sub Sample()
    Dim arr

    lastrow2 = 2

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

    lastrow2 = 3

    arr = Range("M2:M" amp; 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)

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

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

Поскольку это не коллекция или массив, это единственное значение — вы можете проверить это, проверив IsArray(arr) перед запуском For Each

Есть несколько способов исправить это, но самым быстрым было бы включить строку If Not IsArray(Arr) Then Arr = Array(Arr) перед вашим For Each , чтобы превратить ее в массив из 1 элемента.

Другие моменты, которые следует учитывать:

• Какова цель вашего On Error Resume Next ?
• Какова цель вашей skip: метки?
• Переменная myrangename не определена — рассмотрите возможность добавления Option Explicit в начало вашего модуля, чтобы «Debug> Compile VBA Project» перехватывал эти ошибки для вас