使用VBscript从Excel导入Outlook日历条目？ [英] Import Outlook calendar entries from Excel with VBscript?

问题描述

我对VBscripts很新。我正在尝试使用VBscript将日历条目从Excel电子表格复制到Outlook日历中。我在论坛上找到了以下脚本：



  Dim objExcel，objWorkbook

    Dim objOutlook，objNameSpace，objFolder，foundItems，objAppt

    Dim i，j，strFilter

    

    Const olFolderCalendar = 9

    

   设置objExcel = CreateObject（" Excel.Application"）

    objExcel.Application.DisplayAlerts = False

   设置objWorkbook = objExcel.Workbooks.Open（" C：\ VBATest \Dates.xlsx"））
    objExcel.Application.Visible = False

    'objExcel.ActiveWorkbook.Save'

   设置objOutlook = CreateObject（" Outlook.Application"）

   设置objNameSpace = objOutlook.GetNameSpace（" MAPI"）

   设置objFolder = objNameSpace.GetDefaultFolder（olFolderCalendar）

    

   对于i = 1到3

        j = 1

       而j> 0

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; strFilter =" [Start]> ='objWorkbook.Worksheets（i）.Cells（4,2）'AND [Start]< ='objWorkbook.Worksheets（i）.Cells（4,3）'AND [Subject ='objWorkbook.Worksheets（i）.Cells（6，j）'"

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置foundItems = objFolder.Items.Restrict（strFilter）

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置foundItems = objFolder.Items.Restrict（strFilter）

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;如果foundItems.Count = 1则findItems.Item.Delete

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置objAppt = objFolder.Items.Add

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;使用objAppt

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; .Subject =" objWorkbook.Worsheets（i）.Cells（6，j）"

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; .Body =" objWorkbook.Worsheets（i）.Cells（6，j）"

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; .Start =" objWorkbook.Worsheets（i）.Cells（7，j）"

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; .AllDayEvent = True

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; .ReminderMinutesBeforeStart = 1440

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; &NBSP; 。保存¥b $ b  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;结束与$
  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;设置j = j + 1

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;如果objWorkbook.Worksheets（i）.Cells（6，j）=" stop"然后设置j = 0

  &NBSP; &NBSP; &NBSP; &NBSP; &NBSP;如果objWorkbook.Worksheets（i）.Cells（6，j）=" stop"然后j = 0

  &NBSP; &NBSP; &NBSP; Wend b
  &NBSP;下一个

  &NBSP; objWorkbook.Close False

  &NBSP;设置objExcel = Nothing

  &NBSP;设置objWorkbook = Nothing

  &NBSP;设置objOutlook = Nothing

  &NBSP;设置objNameSpace = Nothing

  &NBSP;设置objFolder = Nothing

  &NBSP;设置objAppt = Nothing 



但运行时出现以下错误：



错误第20行：无法解析条件。错误在"[Subject ='objWorkbook.Worksheets（i）.Ce ..."。

代码80020009.

$
想法如何解决这个问题？

Hi,

I am pretty new to VBscripts. I am trying to use a VBscript to copy calendar entries from an excel spreadsheet into an Outlook Calendar. I have found on forums this script below:

 Dim objExcel, objWorkbook
    Dim objOutlook, objNameSpace, objFolder, foundItems, objAppt
    Dim i, j, strFilter
    
    Const olFolderCalendar = 9
    
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Application.DisplayAlerts = False
    Set objWorkbook = objExcel.Workbooks.Open("C:\VBATest\Dates.xlsx")
    objExcel.Application.Visible = False
    'objExcel.ActiveWorkbook.Save'
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNameSpace = objOutlook.GetNameSpace("MAPI")
    Set objFolder = objNameSpace.GetDefaultFolder(olFolderCalendar)
    
    For i = 1 To 3
        j = 1
        While j > 0
            strFilter = "[Start] >= 'objWorkbook.Worksheets(i).Cells(4,2)' AND [Start] <= 'objWorkbook.Worksheets(i).Cells(4,3)' AND [Subject = 'objWorkbook.Worksheets(i).Cells(6,j)'"
            Set foundItems = objFolder.Items.Restrict(strFilter)
            Set foundItems = objFolder.Items.Restrict(strFilter)
            If foundItems.Count = 1 Then foundItems.Item.Delete
            Set objAppt = objFolder.Items.Add
            With objAppt
                .Subject = "objWorkbook.Worsheets(i).Cells(6,j)"
                .Body = "objWorkbook.Worsheets(i).Cells(6,j)"
                .Start = "objWorkbook.Worsheets(i).Cells(7,j)"
                .AllDayEvent = True
                .ReminderMinutesBeforeStart = 1440
                .Save
            End With
            Set j = j + 1
            If objWorkbook.Worksheets(i).Cells(6, j) = "stop" Then Set j = 0
            If objWorkbook.Worksheets(i).Cells(6, j) = "stop" Then j = 0
        Wend
    Next
    objWorkbook.Close False
    Set objExcel = Nothing
    Set objWorkbook = Nothing
    Set objOutlook = Nothing
    Set objNameSpace = Nothing
    Set objFolder = Nothing
    Set objAppt = Nothing 

but I get the below error when I run it:

Error on line 20: Cannot parse condition. Error at "[Subject = 'objWorkbook.Worksheets(i).Ce...".
Code 80020009.

Any ideas how I can resolve this?

推荐答案

这是因为'objWorkbook.Worksheets（i）.Cells（4,2）'等字符串实际上是部分条件，您需要改为使用它们的值：

This is because strings like 'objWorkbook.Worksheets(i).Cells(4,2)' etc are actually part of the condition, you need to use their values instead:

strFilter =" [Start]> ='" &安培; objWorkbook.Worksheets（i）.Cells（4,2）& "'和[开始]< ='" &安培; objWorkbook.Worksheets（i）.Cells（4,3）& "'AND [Subject ='" &安培; objWorkbook.Worksheets（i）.Cells（6，j）& "'"

strFilter = "[Start] >= '" & objWorkbook.Worksheets(i).Cells(4,2) & "' AND [Start] <= '" & objWorkbook.Worksheets(i).Cells(4,3) & "' AND [Subject = '" & objWorkbook.Worksheets(i).Cells(6,j) & "'"

这篇关于使用VBscript从Excel导入Outlook日历条目？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！