在 Excel 中循环行以选择要发送 Outlook 电子邮件的信息在第二行遇到错误

Question

Sub email_Advice()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngSubject As Range
    Dim rngRef As Range
    Dim rngBody As Range
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
    ID = CreateObject("WScript.Network").UserName

    Range("V8").Select
    XX = ActiveCell.Row
    
Next_Ref:
    If Range("V" & XX).Value = "" Then
        If ActiveCell.Offset(0, -1).Value = "" Then
        
        Set objOutlook = Nothing
        Set objMail = Nothing
        Set rngTo = Nothing
        Set rngSubject = Nothing
        Set rngBody = Nothing
        
        Exit Sub
        Else
        MsgBox ("Click to generate for next vendor")
        With ActiveSheet
            Set rngTo = .Range("M" & XX)
            Set rngSubject = .Range("O" & XX)
            Set rngBody = .Range("P" & XX)
            Set rngRef = .Range("T" & XX)
        End With
        
        With objMail
         .To = rngTo.Value
         .Subject = rngSubject.Value
         .Body = rngBody.Value
         .Attachments.Add "C:\Users\" & ID & "\Desktop\WHT \" & rngRef & ".pdf"
            .Send
        End With
        
        ActiveCell.Value = "YES"
        ActiveCell.Offset(1, 0).Select
        XX = XX + 1
        GoTo Next_Ref
        End If
    Else
    
    Exit Sub
    End If
    
End Sub

我执行了上面的代码，希望它循环遍历每一行，选择发送电子邮件所需的信息，直到到达空白单元格。

代码在第二行遇到错误：

运行时错误
该项目已被移动或删除

Answer 1

未经测试

Option Explicit

Sub email_Advice()
    Dim objOutlook As Object, objMail As Object
    Dim ID As String, FOLDER as String
    Dim lastrow As Long, r As Long, n As Long
    
    ID = CreateObject("WScript.Network").UserName
    FOLDER = "C:\Users\" & ID & "\Desktop\WHT \"
    Set objOutlook = CreateObject("Outlook.Application")

    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "U").End(xlUp).Row
        For r = 8 To lastrow
            If .Cells(r, "V") = "" Then
                If vbYes = MsgBox("Generate for vendor " & .Cells(r, "M"), vbYesNo) Then
                    Set objMail = objOutlook.CreateItem(0)
                    With objMail
                        .To = .Cells(r, "M")
                        .Subject = .Cells(r, "O")
                        .Body = .Cells(r, "P")
                        .Attachments.Add FOLDER & .Cells(r, "T") & ".pdf"
                        .Send
                    End With
                    .Cells(r, "V") = "YES"
                    n = n + 1
                End If
            End If
        Next
    End With
    
    Set objOutlook = Nothing
    Set objMail = Nothing
    
    MsgBox n & " emails sent", vbInformation

End Sub