VBscriptでOutlook VBAモジュールを実行するにはどうすればよいですか？

Question

私は今、この問題を2〜3時間作業しています。私は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"型の変数を宣言することはできません。 CMDコンソールで.vbsファイルを実行するcscript.exe add_calendar_item.vbs

辞書とseachApptsを簡単に削除して、VBAサンプルのように1つのアポイントメントしか使用しないようにするには。

、ピーターちょっとここで参考のために、このコード

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