Question

我一直在问那些比我更熟悉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部分的内容。

任何帮助都会受到赞赏 - 我不介意阅读我只是在某一点上，我无法弄清楚下一部分的内容/去向。

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

由于

Answer 1

首次发布

这不是答案。部分是要求澄清，部分是对早期答案的参考，我认为这将有助于您取得进展。

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

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

在回答之前的问题时，我创建了一个宏来演示从Outlook写入Excel。该宏与您的要求不符，但展示了许多相关的技术。点击https://stackoverflow.com/a/12146315/973283即可访问该答案。

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

在澄清

的要求后发布2

答案的下一部分比我希望的要晚。部分是因为这是忙碌的一天，部分是因为我遇到了一个我没想到的问题。

从Outlook中选择Visual Basic编辑器： - 选择工具然后选择宏，然后选择Visual Basic编辑器或 - 单击Alt + F11。

左下方是Project Explorer，可能是：

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

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

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

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

将以下代码粘贴到ThisOutlookSession代码区域。

此代码包含两个宏。打开Outlook时，将自动执行第一个宏Application_Startup（）。它指定收件箱中新项目的到达是触发宏myNewItems_ItemAdd()的调用。它还输出“欢迎”以证明它已被调用。第二个宏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报告宏正在尝试发送电子邮件。关于这个问题的其他所有内容都是直截了当的，但这个问题是一个杀手锏。

Office 2010 VBA - 将SenderEmailAddress传递给Excel工作簿并运行Excel宏以发送电子邮件

1 个答案: