Question

将一些代码拼凑在一起，以提取我每天收到的特定电子邮件的正文，并将其复制到Excel工作簿。

它将在编辑器中手动运行，但是当根据主题正文中的单词将其应用于Outlook中的规则时，它只会打开一个新的Excel工作簿。

也不会出错。

我已经通过论坛阅读和研究，让它达到这个水平，“感谢代码上帝”。

非常感谢任何指导或建议在规则下运行（运行脚本）。

以下代码：

Public Sub SaveEmailBody(itm As Outlook.MailItem)

    Dim outlookApp As New Outlook.Application
    Dim olNs As Outlook.NameSpace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail As Variant
    Dim myTasks
    Dim xlApp As Object
    Dim myXLApp As Excel.Application
    Dim myXLWB As Excel.Workbook
    Dim aFile As String
    Dim TotalRows As Long, i As Long

    'Delete yesterday's file
    aFile = "C:\Reporting\Input_files\Volume.xls"
    If Len(Dir$(aFile)) > 0 Then
    Kill aFile
    End If

    Set outlookApp = CreateObject("Outlook.Application")
    Set olNs = outlookApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items
    Set myXLApp = New Excel.Application
    myXLApp.Visible = True
    Set myXLWB = myXLApp.Workbooks.Add

    'Find today's volume email
    For Each olMail In myTasks
    If (InStr(1, olMail.Body, "ListVolume", vbTextCompare) > 0) Then
        TotalRows = Sheets(1).Range("A65536").End(xlUp).Row
        i = TotalRows + 1 - 1

            With myXLWB.Worksheets(1)
            '.Cells(i, 1) = Format(myItem.SentOn, "mm/dd/yyyy")
            '.Cells(i, 2) = myItem.SenderName
            '.Cells(i, 3) = myItem.To
            .Cells(i, 1) = olMail.Body

            'Save today's volume email
            ActiveWorkbook.SaveAs FileName:="C:\Reporting\Input_files\Volume.xls", FileFormat:= _
            xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
            , CreateBackup:=False

            Set outlookApp = Nothing
            myXLApp.Quit
            Set myXLApp = Nothing
            End With
        Exit For
    End If
    Next

End Sub

Answer 1

无需在VBA宏中创建新的Outlook应用程序实例：

Set outlookApp = CreateObject("Outlook.Application")

相反，您需要使用VBA模块中提供的Application属性：

设置outlookApp = Application

我也看到你迭代所有任务：

'Find today's volume email
For Each olMail In myTasks

我想您希望从收到的电子邮件中获取一些信息。如果是这样，您需要使用传递给sub的参数：

Public Sub SaveEmailBody(itm As Outlook.MailItem)

itm 对象表示传入的电子邮件。请在代码中使用它。

Outlook VBA在编辑器中工作，但不在规则下

1 个答案: