如何在 VBscript 中运行 Outlook VBA 模块?

Question

我已经在这个问题上工作了几个小时了。我有一个 VBA 代码，最初我试图将其转换为 VBscript，但似乎无法做到。 我的 VBA 代码在特定日历(名为"测试"(的 Outlook 中创建会议。此代码完美运行。现在，我需要在 Outlook 窗体中单击命令按钮时运行的代码。VBA 模块不能分配给 Outlook 窗体中的按钮。所以我想做的是有一个VBscript并调用这个模块。 我已将模块保存在文件路径(G：\3500 EDMFO\Script(中。该文件保存为 Module3_Working.bas，我不确定文件扩展名是否应该有所不同。我已经尝试了许多来自论坛的方法，但没有成功。请告知我如何让这个宏在 VBscript 中工作。谢谢。

Sub AddContactsFolder()

If CommandButton1 = False Then
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myNewFolder As Outlook.AppointmentItem
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder =myNameSpace.GetDefaultFolder(olFolderCalendar).Folders("Test")
MsgBox myFolder
Set myNewFolder = myFolder.Items.Add(olAppointmentItem)
'Set myNewFolder = myFolder.Items.Add("Test")
With myNewFolder
.Subject = "Time Off"
.Start = "8/23/2017"
.AllDayEvent = True
.ReminderMinutesBeforeStart = "20"
.Save
End With
End If
End Sub

Answer 1

通过示例将此 VBA 转换为 VBS 应该不是那么困难。 看看 http://www.techsupportforum.com/forums/f128/solved-script-to-delete-outlook-calendar-entries-542865.html 与 url 建议不同，有一个示例说明如何使用纯 Vbscript 将约会(在这种情况下为假期(添加到 Outlook 日历。 我在这里发布代码，以防它消失。

您应该使用 .vbs扩展名(例如 add_calendar_item.vbs(保存代码并提前声明 Outlook 常量。在 vbscript 中不可能用某种类型"as"声明变量。 使用cscript.exe add_calendar_item.vbs在 CMD 控制台中运行 .vbs 文件

为了更容易地删除字典和 seachAppts 部分，并像在 VBA 示例中一样仅使用一个约会。

尝试使用此代码

Const olFolderCalendar = 9
Const olAppointmentItem = 1
Const olOutOfOffice = 3
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) 
Set objApptItems = objCalendar.Items
objApptItems.IncludeRecurrences = True
objApptItems.Sort "[Start]"
Set objHoliday = objOutlook.CreateItem(olAppointmentItem)  
objHoliday.Subject = "Boxing Day"
objHoliday.Start = "December 26, 2017" & " 9:00 AM"
objHoliday.End = "December 26, 2017" & " 10:00 AM"
objHoliday.AllDayEvent = True
objHoliday.ReminderSet = False
objHoliday.BusyStatus = olOutOfOffice
objHoliday.Save

此处参考原始代码

Const olFolderCalendar = 9
Const olAppointmentItem = 1
Const olOutOfOffice = 3
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objCalendar = objNamespace.GetDefaultFolder(olFolderCalendar) 
Set objApptItems = objCalendar.Items
objApptItems.IncludeRecurrences = True
objApptItems.Sort "[Start]"
'' List Appointments to add
Set objDictionary = CreateObject("Scripting.Dictionary")
objDictionary.Add "November 24, 2010", "Thanksgiving"    
objDictionary.Add "November 25, 2010", "Thanksgiving"    
objDictionary.Add "December 25, 2010", "Christmas Day"
objDictionary.Add "December 26, 2010", "Boxing Day"
objDictionary.Add "November 24, 2011", "Thanksgiving"    
objDictionary.Add "November 25, 2011", "Thanksgiving"    
objDictionary.Add "December 25, 2011", "Christmas Day"
objDictionary.Add "December 26, 2011", "Boxing Day"
colKeys = objDictionary.Keys
For Each strKey in colKeys
dtmHolidayDate = strKey
strHolidayName = objDictionary.Item(strKey)
'' Check if it already is on the Calendar
Return = SearchAppts(strHolidayName, FormatDateTime(dtmHolidayDate, vbShortDate))
If Return = False Then 
Set objHoliday = objOutlook.CreateItem(olAppointmentItem)  
objHoliday.Subject = strHolidayName
objHoliday.Start = dtmHolidayDate & " 9:00 AM"
objHoliday.End = dtmHolidayDate & " 10:00 AM"
objHoliday.AllDayEvent = True
objHoliday.ReminderSet = False
objHoliday.BusyStatus = olOutOfOffice
objHoliday.Save
End If
Next
'' Search Function
Function SearchAppts(ByVal strName, strDate)
SearchAppts = False
Set objAppointment = objApptItems.GetFirst
While TypeName(objAppointment) <> "Nothing"
If TypeName(objAppointment) = "AppointmentItem" then
If StrComp(objAppointment, strName,1) = 0 Then
If DateDiff("D", objAppointment.Start, strDate) = 0 Then 
SearchAppts = True
Exit Function
End If  
End If  
End If
Set objAppointment = objApptItems.GetNext
Wend
End Function