Import Outlook calendar entries from Excel

[xSSx]

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:

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)
Dim i
Dim j
For i = 1 To 3
Set j = 1
While j > 0
strFilter = "[Start] >= 'objWorkbook.Worksheets(i).Cells(4,2)' AND [Start] <= 'objWorkbook.Worksheets(i).Cells(4,3)' AND [Subject = 'objWorkbook.Worsheets(i).Cells(6,j)'"
Set foundItems = ojbFolder.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
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:

Invalid procedure call or argument: ‘objNameSpace.GetDefaultFolder’
Code: 800A00005
Source: MSVBScript runtime error

Any ideas how I can resolve this?

 

[guitarzan]

Probably because olFolderCalendar is not defined. Add this to the top:
Const olFolderCalendar = 9

 

[SkipVought]

...and you have some other anomalies:

Do not Set non-object variables like j
ojbFolder is misspelled

'
    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
    '[s]    Set j = 1   '[/s]
        j = 1
        While j > 0
            strFilter = "[Start] >= 'objWorkbook.Worksheets(i).Cells(4,2)' AND [Start] <= 'objWorkbook.Worksheets(i).Cells(4,3)' AND [Subject = 'objWorkbook.Worsheets(i).Cells(6,j)'"
        '    Set foundItems = [s]ojbFolder[/s].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 [s]Set[/s] 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

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[xSSx]

Hi,

Thanks guys.

SkipVought, I have made the changes you suggested. However, I get a different error now:

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

Any ideas?

 

[combo]

You probably need to use the contents of worksheet, so in Subject, Body and Start setting remove quotation marks ([tt].Subject = objWorkbook.Worsheets(i).Cells(6,j)[/tt]).
Test if strFilter returns what you intend to have in your code its always:
[tt][Start] >= 'objWorkbook.Worksheets(i).Cells(4,2)' AND [Start] <= 'objWorkbook.Worksheets(i).Cells(4,3)' AND [Subject = 'objWorkbook.Worsheets(i).Cells(6,j)[/tt]


combo