如何遍历包含字符串的列的行并通过电子邮件发送这些字符串?

时间:2019-02-25 15:41:12

标签: excel vba

我在excel中有一列“ A”,其中包含书名,我试图遍历所有行,并将每个名称通过电子邮件发送给相邻单元格中的电子邮件ID(同一行,“ 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

1 个答案:

答案 0 :(得分:0)

看看Worksheet.Cells property Cells(row, column)而不是Range("A1")并尝试一下SubmitLink_BookName = Cells(i, "A").Value

请注意,如果您命名变量更有意义,例如。使用iRow代替i,则无需评论'i corresponds to row number,因为您可以立即看到此信息。更有意义的名字使您的生活更轻松。

还要始终指定cellsrange在哪个工作簿中:Worksheets("MySheet").Range("A1").Value

另一个问题是您应该使用Option Explicit,因为那样您会看到olMailItem工作不正常。仅当您在VB编辑器菜单›其他›引用中设置了对Outlook库的引用时,才可以使用它,而仅在使用后期绑定CreateObject("Outlook.Application")时才可以使用它。

此外,我还将Outlook应用程序的创建移出您的循环。否则,您将创建20个Outlook。同样不要忘记最后将其销毁。

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