写一个Outlook VBA的代码,功能是实现根据邮件内容,将邮件自动转发到Excel中有相同内容的那一行的第一列的邮箱中
时间: 2023-03-30 09:04:41 浏览: 288
可以的,以下是代码:
Sub ForwardToExcel()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim iLastRow As Integer
Dim iRow As Integer
Dim sSearch As String
Dim sTo As String
Dim objMail As Outlook.MailItem
'获取当前邮件
Set objMail = Application.ActiveInspector.CurrentItem
'打开Excel文件
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\MyExcel.xlsx")
Set xlSheet = xlBook.Worksheets("Sheet1")
'获取Excel表格最后一行
iLastRow = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row
'查找邮件内容在Excel中的行数
sSearch = objMail.Body
For iRow = 1 To iLastRow
If xlSheet.Cells(iRow, "A").Value = sSearch Then
sTo = xlSheet.Cells(iRow, "B").Value
Exit For
End If
Next iRow
'将邮件转发到对应邮箱
If sTo <> "" Then
Set objForward = objMail.Forward
objForward.To = sTo
objForward.Send
End If
'关闭Excel文件
xlBook.Close SaveChanges:=True
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Set objMail = Nothing
End Sub
阅读全文