简体   繁体   中英

Excel VBA send to email address by looking for header "Email" and sending email to first cell beneath matching header

I'm looking send to specific email addresses by looking for header "Email" and then sending email to first cell beneath matching header. the email address column is not always the same which is why i need it to return the cell beneath (which is where the email address is, eg email header ak1-email address ak2) once it matches.

[Excel file example][1] [1]: https://i.stack.imgur.com/dKybj.png

I want to replace range AJ2 in my code with something that can lookup the header (row 1) and insert the email address that corresponds (single cell, row 2)

Range("AJ1").Select
ActiveCell.FormulaR1C1 = "Fund Email"


  'Move the active sheet to a new Workbook
ActiveWindow.SelectedSheets.Copy
ActiveWorkbook.Password = "**********"

ActiveWorkbook.SaveAs 
"\\na\Forrest\Backup.xlsx"
Dim OutApp As Object
Dim OutMail As Object
 Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = Range("AJ2").Value
    .CC = ""
    .BCC = ""
    .Subject = Range("AK2").Value + " -Benefits backup"
    .Body = "Attached is the current month's benefit payment backup for 
check en route to your fund's office."
    .Attachments.Add ActiveWorkbook.FullName
            .send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Close
Dim cel as Range
Dim dst as String       ' Destinataire
Dim sbj as String       ' Subject 

Const FEM = "fund email"  
Range("AJ1").Value = FEM 

ActiveWorkbook.Password = "BlahBlah"
ActiveWorkbook.SaveAs   = "\\na\Forrest\Backup.xlsx"

Set cel = Rows(1).Find(FEM)
sbj = cel.Offset(0,1).Value     '  "CBA"
dst = cel.Offset(1,0).Value     '  "Frank.Barone@usa.com"

On Error Resume Next ' Sends the current workbook by mail 
ActiveWorkbook.SendMail dst, sbj & " -Benefits backup - see Attachment."  
' Unfortunately you cannot fill the body of the mail with this method
On Error GoTo 0

' etc ...

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM