时间戳

首页 > 解决方案 > 通过查找标题“电子邮件”并将电子邮件发送到匹配标题下方的第一个单元格，Excel VBA 发送到电子邮件地址

excel - 通过查找标题“电子邮件”并将电子邮件发送到匹配标题下方的第一个单元格，Excel VBA 发送到电子邮件地址

问题描述

我正在寻找通过查找标题“电子邮件”然后将电子邮件发送到匹配标题下的第一个单元格来发送到特定的电子邮件地址。电子邮件地址列并不总是相同，这就是为什么我需要它在匹配后返回下面的单元格（这是电子邮件地址所在的位置，例如电子邮件标题 ak1-电子邮件地址 ak2）。

【Excel文件示例】【1】【1】：https://i.stack.imgur.com/dKybj.png

我想用可以查找标题（第 1 行）并插入对应的电子邮件地址（单个单元格，第 2 行）的东西替换我的代码中的范围 AJ2

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

标签： excelvba

解决方案

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 ...

推荐阅读