Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Import Outlook calendar entries from Excel

Status
Not open for further replies.

xSSx

Systems Engineer
Aug 29, 2017
2
0
0
GB
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?
 
Probably because olFolderCalendar is not defined. Add this to the top:
Const olFolderCalendar = 9
 
...and you have some other anomalies:

Do not Set non-object variables like j
ojbFolder is misspelled
Code:
'
    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]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
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?
 
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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top