Return value of dynamically determined cell

2019-08-09 02:39发布

The code below verifies if column A in "Sheet1" has the same value as column A in "Sheet2". If so, an email address should be taken from column B "Sheet2".

My problem is getting the email address from "Sheet2" column B.

Sub mail()

    Dim A As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim wb As Workbook
    Dim check

    Set wb = Excel.ActiveWorkbook
    Set sh1 = wb.Worksheets(1)
    Set sh2 = wb.Worksheets(2)
    Application.ScreenUpdating = False

    For A = 2 To sh1.Cells(Rows.Count, "A").End(xlUp).Row

        check = Application.match(sh1.Cells(A, 1).Value, sh2.Columns(1), 0)

        If IsError(check) Then
            MsgBox "No email was found!"
        Else
            ' i am not able to set this.
            'h = take the email address from sheet2 column B

            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.createItem(olmailitem)
            Set wb2 = ActiveWorkbook
            ActiveWorkbook.Save

            With OutMail
                .Display
                .To = h ' attached the email address
                .cc = ""
                .BCC = ""
                .Subject = "Test - " '& B & " " & F
                .htmlbody = "<p style='font-family:calibri;font-size:15'>" & "Hi " & C & "<BR/>" & "<BR/>" & "Please check the attached template." & "<br/>" & "<BR/>" & "Change data if required." & "<BR/>" & "<br/>" & "This e-mail has been automatically send! " & "<br/>" & "<br/>" & "With best regards," & "<br/>" & "<br/>" 
                .attachments.Add wb2.FullName
            End With

            ActiveWorkbook.Close              
        End If

    Next

End Sub

1条回答
我欲成王,谁敢阻挡
2楼-- · 2019-08-09 02:51

With the help of "PEH" i succeed in finding a solution for this:

Sub mail()

    Dim A As Long
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim wb As Workbook

    Dim check

    Set wb = Excel.ActiveWorkbook
    Set sh1 = wb.Worksheets(1)
    Set sh2 = wb.Worksheets(2)

    For A = 2 To sh1.Cells(Rows.Count, "A").End(xlUp).Row
        check = Application.match(sh1.Cells(A, 1).Value, sh2.Columns(1), 0)

        If IsError(check) And Not IsEmpty(sh1.Cells(A, 1)) Then
            MsgBox "No email was found!"
        Else
            h = sh2.Cells(check, 2).Value


            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.createItem(olmailitem)
            Set wb2 = ActiveWorkbook
            wb.Save

            With OutMail
                .Display
                .To = h
                .cc = ""
                .BCC = ""
                .Subject = "Test - " '& B & " " & F
                .htmlbody = "<p style='font-family:calibri;font-size:15'>" & "Hi " & C & "<BR/>" & "<BR/>" & "Please check the attached template." & "<br/>" & "<BR/>" & "Change data if required." & "<BR/>" & "<br/>" & "This e-mail has been automatically send! " & "<br/>" & "<br/>" & "With best regards," & "<br/>" & "<br/>"
                .attachments.Add wb2.FullName
            End With

            wb.Close
        End If
Next

End Sub
查看更多
登录 后发表回答