Excel VBA: как получить доступ к данным во всех ячейках столбца с помощью цикла и назначить эти данные строковой переменной? - PullRequest
0 голосов
/ 23 февраля 2019

Я хотел бы узнать: у меня есть столбец (столбец «F») флагов («1» для «Да» и «0» для «Нет»).Я хотел бы пройтись по каждой ячейке в столбце, и если флаг в этой ячейке равен «1», я хотел бы использовать строковую переменную для хранения данных в других ячейках в этой строке рядом с ячейкой, содержащей «1 'Флаг.

Это так, чтобы я мог взять эти строки, чтобы настроить электронную почту с этой строкой и отправлять много электронных писем различным пользователям, используя идентификаторы электронной почты в столбце «C». Img Вот мой код:

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

    Set KeyCells = Range("F2:F10") 'Range of 'Y/N' for whole column
    SubmitLink_BorrowerName = Range("A2").Value  'SubmitLink contains content of cell B1
    SubmitLink_BookName = Range("B2").Value  'SubmitLink contains content of cell B1
    SubmitLink_CheckoutDate = Range("D2").Value  'SubmitLink contains content of cell B1
    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
        If Cells(i, 6).Value = 1 And Not IsEmpty(Cells(i, 6).Value) Then
            Cells(i, 6).Font.Color = vbBlue


        '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("C2").Value
        'Add subject
        newmsg.Subject = "Book: " & SubmitLink_BookName & " overdue" 'Worksheets("Sheet1").Range("F1").Value
        'Add body
        newmsg.Body = "Dear " & SubmitLink_BorrowerName & "," & vbLf & vbLf & "This is a friendly reminder that Book: " & SubmitLink_BookName & " borrowed on " & SubmitLink_CheckoutDate & " has not yet been returned to the PC team." & vbLf & vbLf & "Kindly return this book to the Book shelf" & vbLf & "Regards, " & vbLf & vbLf & "Admin"

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


        End If
    End If



End Sub

Заранее спасибо!

1 Ответ

0 голосов
/ 23 февраля 2019

Вы забыли добавить Next i. strong text

If answer = vbYes Then
    For i = 2 To 20
    If Cells(i, 6).Value = 1 And Not IsEmpty(Cells(i, 6).Value) Then
        Cells(i, 6).Font.Color = vbBlue


    '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("C2").Value
    'Add subject
    newmsg.Subject = "Book: " & SubmitLink_BookName & " overdue" 'Worksheets("Sheet1").Range("F1").Value
    'Add body
    newmsg.Body = "Dear " & SubmitLink_BorrowerName & "," & vbLf & vbLf & "This is a friendly reminder that Book: " & SubmitLink_BookName & " borrowed on " & SubmitLink_CheckoutDate & " has not yet been returned to the PC team." & vbLf & vbLf & "Kindly return this book to the Book shelf" & vbLf & "Regards, " & vbLf & vbLf & "Admin"

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


    End If
 Next i

End If
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...