Как перебрать строки столбца, содержащие строки, и отправить эти строки по электронной почте?

Question

У меня есть столбец «A» в Excel, содержащий «Имена книг», я пытаюсь перебрать все строки и отправить каждое имя по электронной почте на идентификатор электронной почты в соседней ячейке (та же строка, столбец «B»).Как я могу пройти по разным строкам, чтобы получить доступ к строкам, содержащимся в этих ячейках?

Sub Sendmail()        
    Dim answer As String
    Dim SubmitLink_BookName As String
    Dim KeyCells As Range
    Dim i As Long

    Set KeyCells = Range("F2:F10") 'Range of 'Y/N' for whole column

    answer = MsgBox("Do you wish to save this change. An Email will be sent to the User", vbYesNo, "Save the change")

    If answer = vbNo Then Cancel = True
    If answer = vbYes Then
        For i = 2 To 20 'i corresponds to row number
            SubmitLink_BookName = Range("A2").Value  'HELP- SubmitLink contains content appropriate cell- need help here

            'Open Outlook
            Set OutlookApp = CreateObject("Outlook.Application")
            Set OlObjects = OutlookApp.GetNamespace("MAPI")
            Set newmsg = OutlookApp.CreateItem(olMailItem)
            'Add recipient
            newmsg.Recipients.Add Worksheets("Sheet1").Range("B2").Value
            'Add subject
            newmsg.Subject = "Book: " & SubmitLink_BookName & "." 'Worksheets("Sheet1").Range("F1").Value
            'Add body
            newmsg.Body = "Book" & SubmitLink_BookName 

            'Display
            newmsg.Display
            newmsg.Send
            MsgBox "Modification confirmd", , "Confirmation"


            End If
        Next i
    End If
End Sub

Answer 1

Взгляните на Worksheet.Cells свойство Cells(row, column) вместо Range("A1") и попробуйте SubmitLink_BookName = Cells(i, "A").Value

Обратите внимание, что если вы называете свои переменные более значимыминапример.iRow вместо i, тогда вам не нужно комментировать 'i corresponds to row number, потому что вы мгновенно видите эту информацию.Более значимые имена сделают вашу жизнь проще.

Также всегда указывайте, в какой рабочей книге находится cells или range: Worksheets("MySheet").Range("A1").Value

Другая проблема заключается в том, что вы должны использовать Option Explicit, потому что тогда вы увидите, что ваш olMailItem не работает правильно.Вы можете использовать его, только если вы установили ссылку на библиотеку Outlook в меню VB Editor ›Дополнительная информация› Ссылки, но не если вы используете только позднюю привязку CreateObject("Outlook.Application").

Также я бы перенес созданиеПриложение Outlook вышло из вашего цикла.В противном случае вы создаете 20 перспектив.Также не забудьте уничтожить его в конце.

Option Explicit

Public Sub Sendmail()
    Dim ws As Worksheet 'define worksheet to use it for all Range and Cells
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim KeyCells As Range
    Set KeyCells = ws.Range("F2:F10") 'Range of 'Y/N' for whole column

    Dim Answer As String
    Answer = MsgBox("Do you wish to save this change. An Email will be sent to the User", vbYesNo, "Save the change")


    Dim SubmitLink_BookName As String

    If Answer <> vbYes Then
        Dim OutlookApp As Object
        Set OutlookApp = CreateObject("Outlook.Application")

        Dim OlObjects As Object
        Set OlObjects = OutlookApp.GetNamespace("MAPI")

        Dim NewMsg As Object

        Dim iRow As Long
        For iRow = 2 To 20
            SubmitLink_BookName = ws.Cells(iRow, "A").Value

            Set NewMsg = OutlookApp.CreateItem(olMailItem)
            'Add recipient
            NewMsg.Recipients.Add ws.Cells(iRow, "B").Value
            'Add subject
            NewMsg.Subject = "Book: " & SubmitLink_BookName & "." 'ws.Range("F1").Value
            'Add body
            NewMsg.Body = "Book" & SubmitLink_BookName

            'Display
            NewMsg.Display
            NewMsg.Send
            MsgBox "Modification confirmd", , "Confirmation"
        Next iRow

        OutlookApp.Quit 'don't forget to end the outlook app you created
        Set OutlookApp = Nothing
    End If

End Sub