Vba 使用VBScript调用Outlook过程

我在Outlook中有一个过程，用于发送

Drafts

文件夹中保存的所有邮件。
下面是代码：

Public Sub SendMail()

Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olDraft As Outlook.MAPIFolder
Dim strfoldername As String
Dim i As Integer

Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(olFolderInbox)

strfoldername = olFolder.Parent

Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")

If olDraft.Items.Count <> 0 Then
    For i = olDraft.Items.Count To 1 Step -1
        olDraft.Items.Item(i).Send
    Next
End If

End Sub

我也读过关于

会话.登录的内容，如下所示：

Dim olApp

Set olApp = CreateObject("Outlook.Application")
olApp.Session.Logon
olApp.ProcedureName

Set olApp = Nothing

但它会抛出错误，表示不支持对象
ProcedureName
。

希望有人能给我们一些启示。

解决方案：

好的，我已经想出了2个办法来避免或通过这个弹出窗口


第一个：正如卡兹贾夫指出的那样。

假设您有另一个程序（例如Excel、VBScript），其中包括通过过程中的
Outlook
发送邮件。

不要使用
.Send
，只需
.Save
邮件即可。

它将保存在Outlook的草稿文件夹中。

然后使用下面的代码，发送使用
Outlook任务提醒触发的草稿


Option Explicit
Private WithEvents my_reminder As Outlook.Reminders

Private Sub Application_Reminder(ByVal Item As Object)

Dim myitem As TaskItem

If Item.Class = olTask Then 'This works the same as the next line but i prefer it since it automatically provides you the different item classes.
'If TypeName(Item) = "TaskItem" Then
    Set my_reminder = Outlook.Reminders
    Set myitem = Item
    If myitem.Subject = "Send Draft" Then
        Call SendMail
    End If
End If

End Sub

Private Sub my_reminder_BeforeReminderShow(Cancel As Boolean)

Cancel = True
Set my_reminder = Nothing

End Sub

当显示主题为“发送草稿”的任务提醒时，上述代码将触发。

但是，我们不希望它显示出来，因为整个要点只是调用
SendMail
过程。

因此，我们添加了一个过程
取消
提示的显示，该提示属于
olTask
类或
TaskItem
类型。

这当然要求
Outlook
正在运行。

您可以像我一样让它24小时运行，或者创建一个
VBscript
，通过
Task Scheduler
打开它进行计划

第二个：是在安全弹出窗口出现时使用API以编程方式单击允许按钮。

感谢SiddarthRout的帮助。

以下是帮助您以编程方式单击“允许”按钮的选项。

当然你得稍微调整一下

我将在Outlook、模块或ThisOutlookSession中将过程放在何处

都不是。将以下代码粘贴到文本文件中，并将其另存为
.VBS
文件。然后从任务计划程序调用此VBS文件，如图所示

Dim olApp、olNS、olFolder、olDraft、strfoldername、i
设置olApp=GetObject（，“Outlook.Application”）
Set olNS=olApp.GetNamespace（“MAPI”）
设置olFolder=olNS.GetDefaultFolder（6）
strfoldername=olFolder.Parent
Set olDraft=olNS.Folders（strfoldername）.Folders（“草稿”）
如果olDraft.Items.Count为0，则
对于i=olDraft.Items.Count到1步骤-1
olDraft.Items.Item（i）.发送
下一个
如果结束
经过测试

假设Outlook应用程序一直在运行（根据问题下方的注释），您可以按以下步骤执行所需操作：

在Outlook中添加新任务，将主题设置为：“运行宏YourMacroName”，并设置宏启动的时间（加上周期）

转到VBA编辑器，打开
ThisOutlookSession模块
，并在其中添加以下代码（另外请参见代码中的注释）：


如果您使用的是Outlook 2007或更新版本，我发现您可以通过执行以下操作轻松消除在运行脚本时出现的上述安全弹出窗口：

在Outlook 2007信任中心中，转到宏安全性-选择“不检查宏的安全性”

在Outlook 2007信任中心中，转到Programatic Access-选择“从不警告我可疑活动”

当然，从技术上讲，这会让你很容易被别人通过电子邮件发送给你一些恶意的电子邮件脚本或类似的东西。我相信我的公司已经管理了这些脚本，这对我来说很有效。我可以在Outlook、Access、Excel中使用VBS脚本发送电子邮件，而不需要安全弹出窗口

另一种选择：

如果您不想这样做，在此之前对我有效的另一个选择是：

基本上是一个不包含弹出窗口的dll重定向。它保留了您的其他默认安全性，您可以编写\调用VBA来获取它，并在没有安全弹出窗口的情况下发送邮件。
那么您是说调用
是不可能的吗？不，我不是这么说，因为我没有测试它。请稍候。让我重新检查一下。以上是一个shot最有效的方法。好的，我这样做是因为我的
Outlook
在发送邮件时会弹出安全窗口。出于好奇，我想，如果我调用这个过程，并且
Outlook
仍然发送邮件，弹出窗口还会触发吗？上面的工作正常，但邮件的发送仍然有效由另一个
程序触发。因此弹出窗口仍然出现。我刚刚测试了它。你需要将macto放入
ThisOutlookSession
。一旦这样做，你就可以使用
Application.SendMail
在outlook中调用该宏。但是在outlook VBA之外似乎不支持这种技术。进一步研究……好的，我做了一个简单的尝试TLE的研究，它似乎不支持应用程序。MyAcro从VBScript。我看到下面的Sid的答案和下面的讨论。你是否考虑了下面的步骤：1？使用窗口任务调度程序运行Outlook（只是Outlook exe，而不是VBScript文件）。我认为这在您的操作系统中是可能的。2.使用
Private Sub Application_Startup（）事件
在
ThisOutlookSession
中。3.在事件集
if语句中
指的是宏应该启动的时间。
在条件语句中调用宏
。结论：如果步骤1在步骤3中选中的某个时间运行，我想，您会得到所需的。@KazJaw感谢您抽出时间。但这是非常重要的不可能，因为我安排了其他任务，这要求OL始终运行。但我会检查是否可以设置时间。这是否意味着您的OL应用程序（几乎）始终运行？然后您可以（可能）使用Outlook任务来执行此作业（而不是Windows系统任务）。是的，总是在运行。是的，我没有尝试过：DOk this works.：）但是我如何取消提醒。如果它保持可见，其他任务将不会运行。抱歉，尚未处理任务：p als
Option Explicit
Private WithEvents my_reminder As Outlook.Reminders

Private Sub Application_Reminder(ByVal Item As Object)

Dim myitem As TaskItem

If Item.Class = olTask Then 'This works the same as the next line but i prefer it since it automatically provides you the different item classes.
'If TypeName(Item) = "TaskItem" Then
    Set my_reminder = Outlook.Reminders
    Set myitem = Item
    If myitem.Subject = "Send Draft" Then
        Call SendMail
    End If
End If

End Sub

Private Sub my_reminder_BeforeReminderShow(Cancel As Boolean)

Cancel = True
Set my_reminder = Nothing

End Sub

Dim olApp, olNS, olFolder, olDraft, strfoldername, i

Set olApp = GetObject(, "Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(6)

strfoldername = olFolder.Parent

Set olDraft = olNS.Folders(strfoldername).Folders("Drafts")

If olDraft.Items.Count <> 0 Then
    For i = olDraft.Items.Count To 1 Step -1
        olDraft.Items.Item(i).Send
    Next
End If

Private Sub Application_Reminder(ByVal Item As Object)

If TypeName(Item) = "TaskItem" Then
    Dim myItem As TaskItem
    Set myItem = Item
    If myItem.Subject = "run macro YourMacroName" Then

        Call YourMacroName    '...your macro name here

    End If
End If
End Sub