0

我一直在询问比我更熟悉 VBA 的人，但没有我希望的那种运气。这是我需要的：

  • 主题行中带有“Stats1”、“Stats2”、“Stats3”（等）的传入电子邮件
  • 规则被触发，捕获发件人的电子邮件地址
  • 打开工作簿并将电子邮件地址传递给工作簿（例如：emaillog.xlsm）
  • 附加到工作簿（不覆盖）
  • 在“emaillog.xlsm”上记录电子邮件地址、时间和日期
  • 运行一个 excel 脚本（例如 emailsend.xlsm）
  • 将数据范围从“emailsend.xlsm”发送到“emaillog.xlsm”上的最新条目
  • 保存并关闭“emaillog.xlsm”

这是我要发送的 Excel 部分的内容：

Public dTime As Date
Sub AutoSchedule1()
    dTime = Now() + TimeValue("01:00:00")
    Sheet("Sheet1").Range("u1").Value = "Email On, next send at " & Hour(dTime) & ":" & Minute(dTime)
    ActiveWorkbook.RefreshAll
    Application.OnTime dTime, "SendStatsTeam"
    If Hour(dTime) >= 18 Then
        Application.OnTime dTime, "SendStatsTeam", , False
        Exit Sub
    End If
End Sub
Sub SendStatsTeam()
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range
    Dim Hournow As Long
    AutoSchedule1
    On Error GoTo StopMacro
    If Hour(Now()) > 12 Then
    Hournow = Hour(Now()) - 12
    Else
    Hournow = Hour(Now())
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sendrng = Worksheets("Sheet1").Range("A1:Z26")

    Set AWorksheet = ActiveSheet

    With Sendrng

        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

            .Introduction = "Here are your stats"

            With .Item
                .To = SenderEmailAddress
                .CC = ""
                .BCC = ""
                .Subject = "Stats so far today" & Hour(Now()) & ":" & Application.WorksheetFunction.Text(Minute(Now()), "00")
                .Send
            End With

        End With

        rng.Select
    End With

    AWorksheet.Select

StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False

End Sub

Sub emailoff()
Application.OnTime dTime, "SendStatsTeam", , False
    Worksheets("Sheet2").Range("u1").Value = "Email Off"
End Sub

我意识到我在这里没有正确完成所有事情，因为我对 VBA 还很陌生，但是我已经尽我所能来弄清楚 Outlook 部分。

任何帮助将不胜感激 - 我不介意阅读我只是在我无法弄清楚下一部分该做什么/去哪里的时候。

如果您选择提供帮助，我想添加根据电子邮件主题发送不同范围的不同工作表的功能。

谢谢

4

1 回答 1

0

初次过帐

这不是一个答案。这部分是要求澄清的要求，部分是对早期答案的参考，我相信这将有助于您取得进步。

为 Outlook 编写的 VBA 宏和为 Excel 编写的 VBA 宏之间几乎没有区别。您是否有理由要从 Outlook 运行 Excel 宏？在没有 Outlook 的情况下包含宏会更容易。例如这样的：

  • 新电子邮件触发的新项目事件宏。
  • 宏检查主题。
  • 如果主题是关键字，则打开相应的 Excel 工作簿，存储电子邮件的详细信息，根据工作簿中的信息创建回复并关闭工作簿。
  • 将已处理的电子邮件移至存档文件夹。

为了回答前面的问题，我创建了一个宏来演示如何从 Outlook 写入 Excel。该宏不符合您的要求，但演示了许多相关的技术。单击https://stackoverflow.com/a/12146315/973283以访问该答案。

我希望以上几点有所帮助。如有必要，请务必返回澄清或进一步的问题。

发帖2后要求澄清

答案的下一部分比我希望的要晚。部分是因为今天很忙，部分是因为我遇到了一个我没有预料到的问题。

在 Outlook 中，通过以下方式选择 Visual Basic 编辑器： - 选择工具，然后选择宏，然后选择 Visual Basic 编辑器，或者 - 单击 Alt+F11。

左边是项目资源管理器，它可能是：

- Project1 (VbaProject.OTM)
  + Microsoft Outlook Objects
  + Forms
  + Modules

如果您没有表单或模块，这些条目将丢失。存在的任何条目可能已经展开。展开Microsoft Outlook Objects，如果尚未展开，请单击+。显示将变为：

- Project1 (VbaProject.OTM)
  - Microsoft Outlook Objects
      ThisOutlookSession
  + Forms
  + Modules

单击ThisOutlookSession。右上角区域将变为白色（如果它还不是白色）。这是一个代码区，就像一个模块，但用于特殊代码。

将下面的代码粘贴到ThisOutlookSession代码区。

此代码包含两个宏。第一个宏 Application_Startup() 在 Outlook 打开时自动执行。它指定收件箱中新项目的到达将触发宏的调用myNewItems_ItemAdd()。它还输出“Welcome”以证明它已被调用。第二个宏， myNewItems_ItemAdd()识别新项目的类型并将选定的信息输出到即时窗口。

这些宏正确执行，但有一个问题我没有解决。在我看来，Outlook 正确地对宏和访问电子邮件的宏不满意。当您打开 Outlook 时，它会告诉您有宏（前提是您有足够的安全级别），并为您提供启用或禁用这些宏的选项。如果宏尝试访问电子邮件，Outlook 会警告您并提供允许访问最多 10 分钟的选项。

我已经对这些宏进行了自我认证，这些宏告诉 Outlook 我信任它们。这会抑制有关存在宏的警告，但不会像我预期的那样抑制有关宏尝试访问电子邮件的警告。为了我自己的利益，我会进一步调查，但必须准备好每 10 分钟给予一次许可，这违背了你拥有一个新项目事件的目标。

我建议您无论如何都使用这些宏，因为知道此功能的存在可能会在以后有所帮助。

我可以想到三种情况：

  • 如果您为一家拥有 IT 部门的大公司工作，那么您可能无论如何都无法进行自我认证，因为您需要管理权限才能这样做。您需要咨询 IT 部门的建议。
  • 如果我无法确定如何抑制每 10 分钟授予权限的要求，也许 Stack Overflow 上的其他人可以。
  • 例如，每小时一次，您可以运行一个宏来查找自上次运行以来到达的任何请求电子邮件。如果宏找到任何内容，您将授予它处理它们的权限。如果这种方法有吸引力，我肯定知道如何实现这样的宏。

.

 Option Explicit
 Public WithEvents MyNewItems As Outlook.Items
 Private Sub Application_Startup()

   ' This event procedure is called when Outlook is started

   Dim NS As NameSpace

   Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")

   With NS
    Set MyNewItems = NS.GetDefaultFolder(olFolderInbox).Items
   End With

   MsgBox "Welcome"

 End Sub
 Private Sub myNewItems_ItemAdd(ByVal Item As Object)

   ' This event procedure is called whenever a new item is added to
   ' to the InBox.

   Dim NewMailItem As MailItem

   Debug.Print "------Item Received"

   On Error Resume Next
   ' This will give an error and fail to set NewMailItem if
   ' Item is not a MailItem.
   Set NewMailItem = Item
   On Error GoTo 0

   If Not NewMailItem Is Nothing Then
     ' This item is a mail item
     With NewMailItem
       Debug.Print "Subject " & .Subject
       Debug.Print "Sender Email [" & .SenderEmailAddress & "]"
     End With
   Else
     ' Probably a meeting request.
     Debug.Print "Not mail item " & Item.Subject
   End If

 End Sub

对于我的下一篇文章，我将添加一个 Outlook 宏，它可以打开工作簿并对其进行写入和读取。

在您的问题中，您说您想将工作簿中的范围发送给电子邮件的作者。你知道怎么做吗？如果不是，你会发送什么样的范围？你希望它如何出现？将一个小范围转换为 Html 并不困难，如果这会给您想要的外观。

最终发布

抱歉，我放弃了这个问题。我没有尝试阻止 Outlook 报告宏正在尝试发送电子邮件。关于这个问题的其他一切都很简单，但这个问题是一个杀手。

于 2013-04-28T14:36:54.233 回答