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

时间:2017-08-23 18:57:49

标签: vba vbscript outlook outlook-vba outlook-2010

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

class DetailMovie(DetailView):
    model = Movie
    context_object_name = "movie"
    template_name = "detail_movie.html"

1 个答案:

答案 0 :(得分: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