如何在VBscript中運行Outlook VBA模塊？

Question

我一直在這個問題上工作了幾個小時。我有一個VBA代碼，最初我試圖將其轉換爲VBscript，而且似乎無法做到。 我的VBA代碼在特定的日曆（名爲Test）中創建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

爲了更容易掉落的字典和seachAppts一部分，你的VBA樣品中只使用一個像約好運行在CMD控制檯.vbs文件。

嘗試使用此代碼

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