I have a macro that works in Outlook 2003; however, it no longer works in
2007. A .cvs file is attached to an email and the macro is to put the
information from this file into the Outlook Calendar. It should delete
previous calendar entries within the same date range and replace with what is
in the new file. Could someone please help me convert my macro for 2007?

Below is my current code:


Sub ImportSchedule()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim myOlApp
Dim myItem
Dim myAttachments
Dim strBodyText
Dim CRLF
Dim CRTEST
Dim intTxtStartDate, intTxtEndDate, intExchVariable
Dim strExchangeVariable
Dim strExchNewVariable
Dim strLine
Dim intStart
Dim intBreak
Dim strMsg
Dim intAdded
Dim intFirstDate
Dim strResult
Dim sFoldername As String
Dim objPage
Dim fs As Object
Dim s, n
Dim AttachName As String
Dim objAppt
Dim myNameSpace
Dim arrParams
Dim myOlApplic
Dim myAppointments
Dim currentAppointment
Dim onMapi As NameSpace
Dim ofFolder As MAPIFolder
Dim Message, Title, Default, MyValue, Style
Dim Message2, Title2, Default2, MyValue2
Dim strStart, strEnd, nCount
Dim strCalStart, strCalEnd, strTextStart, strTextEnd


'------------Check Attachment to see if it's schedule.txt---------
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set myAttachments = myItem.Attachments
On Error Resume Next
AttachName = myAttachments.Item(1).DisplayName

If AttachName = "Schedule.txt" Then
myAttachments.Item(1).SaveAsFile "C:\" & _
myAttachments.Item(1).DisplayName

intFirstDate = 1
'^^^^^^^^^^^^Check Attachment to see if it's schedule.txt^^^^^^^^^

'---------------DELETE--------------------------------------------
'Set myOlApplic = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApplic.GetNamespace("MAPI")
'Set myAppointments = myNameSpace.GetDefaultFolder _
' (olFolderCalendar).Items
'Set currentAppointment = myAppointments.Find("[Categories] = ""Staff Trak""")

'While TypeName(currentAppointment) "Nothing"
' currentAppointment.Delete
' Set currentAppointment = myAppointments.FindNext
'Wend
'^^^^^^^^^^^^^^^^^^DELETE^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'----------Open schedule.txt file and read it storing values in
strLine------------
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("C:\Schedule.txt")
Set strBodyText = f.OpenAsTextStream(ForReading, TristateFalse)
s = strBodyText.ReadAll
nCount = strBodyText.Count


Set onMapi = GetNamespace("MAPI")

If MsgBox("Will you currently be importing offline?", 3) = vbYes Then
If MsgBox("Will you be importing to a subfolder of the root
Calendar?", 3) = vbYes Then
Title = "Import Schedule (Working Offline)"
Message = "Please supply me with the name of your Root
Calendar Folder:"
Default = "Calendar"
MyValue = InputBox(Message, Title, Default)
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue).Folders(MyValue2)
Else
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue2)
End If


Else
Set ofFolder = onMapi.PickFolder
End If


If ofFolder Is Nothing Then
MsgBox "No Folder Selected, User Cancelled"
Else
MsgBox "Folder - " & ofFolder.Name & " was selected by the user"
Set myAppointments = ofFolder.Items
'/////////Need to get the start and end date of the report
strMsg = ""
intAdded = 0
strStart = ""

CRLF = ":::*" '---------------------Carrige Return Line Feed
CRTEST = ","
'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
intTxtStartDate = ""
intTxtEndDate = ""
intExchVariable = ""

strStart = ""
strEnd = ""
strExchangeVariable = ""

If intBreak 0 Then
Do Until intBreak = 0
strLine = Mid(s, intStart, intBreak - intStart)

If strLine "" Then
If intStart = 1 Then
intTxtStartDate = InStr(1, strLine,
CRTEST) '1ST COMMA start of the report
intTxtEndDate = InStr(intTxtStartDate +
1, strLine, CRTEST) '2ND COMMA end of report start time
intExchVariable = InStr(intTxtEndDate +
1, strLine, CRTEST) '3RD COMMA end of report start time
intExchVariableEnd =
InStr(intExchVariable + 1, strLine, CRTEST) 'end of report

strStart = Mid(strLine, intTxtStartDate
+ 1, intTxtEndDate - (intTxtStartDate + 1)) + " 00:00:00 AM"
strEnd = Mid(strLine, intTxtEndDate + 1,
intExchVariable - (intTxtEndDate + 1)) + " 23:59:00 PM"
strExchangeVariable = Mid(strLine,
intExchVariable + 1, intBreak - (intTest + 4))


End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)

Loop
End If
'////////////////

strExchNewVariable = "[Categories] = """ + strExchangeVariable +
""""
Set currentAppointment = myAppointments.Find(strExchNewVariable)


While TypeName(currentAppointment) "Nothing"
strCalStart = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strCalEnd = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strTextStart = FormatDateTime(strStart, vbGeneralDate)
strTextEnd = FormatDateTime(strEnd, vbGeneralDate)

If ((DateValue(strCalStart) = DateValue(strTextStart)) And
(DateValue(strCalEnd) = DateValue(strTextEnd))) Then
currentAppointment.Delete
End If

Set currentAppointment = myAppointments.FindNext
Wend
End If



CRLF = ":::*" '---------------------Carrige Return Line Feed

strMsg = ""
intAdded = 0

'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
If intBreak 0 Then
Do Until intBreak = 0

strLine = Mid(s, intStart, intBreak - intStart)
strNoLine = InStr(1, strLine, "Nothing")


If strLine "" Then
'Do not want to bring in the 1st line, it now has the
start and enddate of report
If strNoLine = 0 Then
strResult = AddAppt(strLine, ofFolder)
'Sends values to AddAppt Function
strMsg = strMsg & CRLF & strResult
intAdded = intAdded + 1
End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)
Loop
End If
'----------Open schedule.txt file and read it storing values in
strLine------------
'Else
' Exit Sub
End If
f.Delete 'Deletes saved file from C:\
myItem.Close (olDiscard) 'Closes the Inspector window
End Sub

Function AddAppt(strParams, ofFolder)

Dim objAppt As AppointmentItem
Dim arrParams
Dim varStart
Dim strMsg
Dim StartDate, EndDate
Dim check

On Error Resume Next

Set objAppt = ofFolder.Items.Add(olAppointmentItem)



'Set objAppt = Application.CreateItem(olAppointmentItem)


'This function will only work in VBScript 2.0 and later


arrParams = Split(strParams, ",") 'Reads the commas out of the file.
objAppt.Subject = arrParams(0)

'Determine whether an all day event or not
objAppt.AllDayEvent = arrParams(5)

If objAppt.AllDayEvent = True Then
'treats all-day events as single day
varStart = CDate(arrParams(1) & " 12:00 AM")
objAppt.Start = varStart
Else
objAppt.Start = arrParams(1) & " " & arrParams(2)
objAppt.End = arrParams(3) & " " & arrParams(4)

End If

objAppt.ReminderSet = arrParams(6)
If objAppt.ReminderSet = True Then
objAppt.ReminderMinutesBeforeStart = _
DateDiff("m", arrParams(7) & " " & arrParams(8), objAppt.Start)
End If
objAppt.Categories = arrParams(9)
objAppt.Body = arrParams(10)
objAppt.Location = arrParams(11)


objAppt.Save
objAppt.Close (g_Const_olSave)

End Function

What in particular doesn't work?

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Bravadarose" wrote in message ...
I have a macro that works in Outlook 2003; however, it no longer works in
2007. A .cvs file is attached to an email and the macro is to put the
information from this file into the Outlook Calendar. It should delete
previous calendar entries within the same date range and replace with what is
in the new file. Could someone please help me convert my macro for 2007?

Below is my current code:


Sub ImportSchedule()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim myOlApp
Dim myItem
Dim myAttachments
Dim strBodyText
Dim CRLF
Dim CRTEST
Dim intTxtStartDate, intTxtEndDate, intExchVariable
Dim strExchangeVariable
Dim strExchNewVariable
Dim strLine
Dim intStart
Dim intBreak
Dim strMsg
Dim intAdded
Dim intFirstDate
Dim strResult
Dim sFoldername As String
Dim objPage
Dim fs As Object
Dim s, n
Dim AttachName As String
Dim objAppt
Dim myNameSpace
Dim arrParams
Dim myOlApplic
Dim myAppointments
Dim currentAppointment
Dim onMapi As NameSpace
Dim ofFolder As MAPIFolder
Dim Message, Title, Default, MyValue, Style
Dim Message2, Title2, Default2, MyValue2
Dim strStart, strEnd, nCount
Dim strCalStart, strCalEnd, strTextStart, strTextEnd


'------------Check Attachment to see if it's schedule.txt---------
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set myAttachments = myItem.Attachments
On Error Resume Next
AttachName = myAttachments.Item(1).DisplayName

If AttachName = "Schedule.txt" Then
myAttachments.Item(1).SaveAsFile "C:\" & _
myAttachments.Item(1).DisplayName

intFirstDate = 1
'^^^^^^^^^^^^Check Attachment to see if it's schedule.txt^^^^^^^^^

'---------------DELETE--------------------------------------------
'Set myOlApplic = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApplic.GetNamespace("MAPI")
'Set myAppointments = myNameSpace.GetDefaultFolder _
' (olFolderCalendar).Items
'Set currentAppointment = myAppointments.Find("[Categories] = ""Staff Trak""")

'While TypeName(currentAppointment) "Nothing"
' currentAppointment.Delete
' Set currentAppointment = myAppointments.FindNext
'Wend
'^^^^^^^^^^^^^^^^^^DELETE^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'----------Open schedule.txt file and read it storing values in
strLine------------
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("C:\Schedule.txt")
Set strBodyText = f.OpenAsTextStream(ForReading, TristateFalse)
s = strBodyText.ReadAll
nCount = strBodyText.Count


Set onMapi = GetNamespace("MAPI")

If MsgBox("Will you currently be importing offline?", 3) = vbYes Then
If MsgBox("Will you be importing to a subfolder of the root
Calendar?", 3) = vbYes Then
Title = "Import Schedule (Working Offline)"
Message = "Please supply me with the name of your Root
Calendar Folder:"
Default = "Calendar"
MyValue = InputBox(Message, Title, Default)
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue).Folders(MyValue2)
Else
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue2)
End If


Else
Set ofFolder = onMapi.PickFolder
End If


If ofFolder Is Nothing Then
MsgBox "No Folder Selected, User Cancelled"
Else
MsgBox "Folder - " & ofFolder.Name & " was selected by the user"
Set myAppointments = ofFolder.Items
'/////////Need to get the start and end date of the report
strMsg = ""
intAdded = 0
strStart = ""

CRLF = ":::*" '---------------------Carrige Return Line Feed
CRTEST = ","
'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
intTxtStartDate = ""
intTxtEndDate = ""
intExchVariable = ""

strStart = ""
strEnd = ""
strExchangeVariable = ""

If intBreak 0 Then
Do Until intBreak = 0
strLine = Mid(s, intStart, intBreak - intStart)

If strLine "" Then
If intStart = 1 Then
intTxtStartDate = InStr(1, strLine,
CRTEST) '1ST COMMA start of the report
intTxtEndDate = InStr(intTxtStartDate +
1, strLine, CRTEST) '2ND COMMA end of report start time
intExchVariable = InStr(intTxtEndDate +
1, strLine, CRTEST) '3RD COMMA end of report start time
intExchVariableEnd =
InStr(intExchVariable + 1, strLine, CRTEST) 'end of report

strStart = Mid(strLine, intTxtStartDate
+ 1, intTxtEndDate - (intTxtStartDate + 1)) + " 00:00:00 AM"
strEnd = Mid(strLine, intTxtEndDate + 1,
intExchVariable - (intTxtEndDate + 1)) + " 23:59:00 PM"
strExchangeVariable = Mid(strLine,
intExchVariable + 1, intBreak - (intTest + 4))


End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)

Loop
End If
'////////////////

strExchNewVariable = "[Categories] = """ + strExchangeVariable +
""""
Set currentAppointment = myAppointments.Find(strExchNewVariable)


While TypeName(currentAppointment) "Nothing"
strCalStart = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strCalEnd = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strTextStart = FormatDateTime(strStart, vbGeneralDate)
strTextEnd = FormatDateTime(strEnd, vbGeneralDate)

If ((DateValue(strCalStart) = DateValue(strTextStart)) And
(DateValue(strCalEnd) = DateValue(strTextEnd))) Then
currentAppointment.Delete
End If

Set currentAppointment = myAppointments.FindNext
Wend
End If



CRLF = ":::*" '---------------------Carrige Return Line Feed

strMsg = ""
intAdded = 0

'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
If intBreak 0 Then
Do Until intBreak = 0

strLine = Mid(s, intStart, intBreak - intStart)
strNoLine = InStr(1, strLine, "Nothing")


If strLine "" Then
'Do not want to bring in the 1st line, it now has the
start and enddate of report
If strNoLine = 0 Then
strResult = AddAppt(strLine, ofFolder)
'Sends values to AddAppt Function
strMsg = strMsg & CRLF & strResult
intAdded = intAdded + 1
End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)
Loop
End If
'----------Open schedule.txt file and read it storing values in
strLine------------
'Else
' Exit Sub
End If
f.Delete 'Deletes saved file from C:\
myItem.Close (olDiscard) 'Closes the Inspector window
End Sub

Function AddAppt(strParams, ofFolder)

Dim objAppt As AppointmentItem
Dim arrParams
Dim varStart
Dim strMsg
Dim StartDate, EndDate
Dim check

On Error Resume Next

Set objAppt = ofFolder.Items.Add(olAppointmentItem)



'Set objAppt = Application.CreateItem(olAppointmentItem)


'This function will only work in VBScript 2.0 and later


arrParams = Split(strParams, ",") 'Reads the commas out of the file.
objAppt.Subject = arrParams(0)

'Determine whether an all day event or not
objAppt.AllDayEvent = arrParams(5)

If objAppt.AllDayEvent = True Then
'treats all-day events as single day
varStart = CDate(arrParams(1) & " 12:00 AM")
objAppt.Start = varStart
Else
objAppt.Start = arrParams(1) & " " & arrParams(2)
objAppt.End = arrParams(3) & " " & arrParams(4)

End If

objAppt.ReminderSet = arrParams(6)
If objAppt.ReminderSet = True Then
objAppt.ReminderMinutesBeforeStart = _
DateDiff("m", arrParams(7) & " " & arrParams(8), objAppt.Start)
End If
objAppt.Categories = arrParams(9)
objAppt.Body = arrParams(10)
objAppt.Location = arrParams(11)


objAppt.Save
objAppt.Close (g_Const_olSave)

End Function

When I run it I get a Run-time error '91': Object variable or With block
variable not set. I go into debug and it Highlights this line:

Set myItem = myOlApp.ActiveInspector.CurrentItem

"Sue Mosher [MVP-Outlook]" wrote:

What in particular doesn't work?

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Bravadarose" wrote in message ...
I have a macro that works in Outlook 2003; however, it no longer works in
2007. A .cvs file is attached to an email and the macro is to put the
information from this file into the Outlook Calendar. It should delete
previous calendar entries within the same date range and replace with what is
in the new file. Could someone please help me convert my macro for 2007?

Below is my current code:


Sub ImportSchedule()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim myOlApp
Dim myItem
Dim myAttachments
Dim strBodyText
Dim CRLF
Dim CRTEST
Dim intTxtStartDate, intTxtEndDate, intExchVariable
Dim strExchangeVariable
Dim strExchNewVariable
Dim strLine
Dim intStart
Dim intBreak
Dim strMsg
Dim intAdded
Dim intFirstDate
Dim strResult
Dim sFoldername As String
Dim objPage
Dim fs As Object
Dim s, n
Dim AttachName As String
Dim objAppt
Dim myNameSpace
Dim arrParams
Dim myOlApplic
Dim myAppointments
Dim currentAppointment
Dim onMapi As NameSpace
Dim ofFolder As MAPIFolder
Dim Message, Title, Default, MyValue, Style
Dim Message2, Title2, Default2, MyValue2
Dim strStart, strEnd, nCount
Dim strCalStart, strCalEnd, strTextStart, strTextEnd


'------------Check Attachment to see if it's schedule.txt---------
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set myAttachments = myItem.Attachments
On Error Resume Next
AttachName = myAttachments.Item(1).DisplayName

If AttachName = "Schedule.txt" Then
myAttachments.Item(1).SaveAsFile "C:\" & _
myAttachments.Item(1).DisplayName

intFirstDate = 1
'^^^^^^^^^^^^Check Attachment to see if it's schedule.txt^^^^^^^^^

'---------------DELETE--------------------------------------------
'Set myOlApplic = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApplic.GetNamespace("MAPI")
'Set myAppointments = myNameSpace.GetDefaultFolder _
' (olFolderCalendar).Items
'Set currentAppointment = myAppointments.Find("[Categories] = ""Staff Trak""")

'While TypeName(currentAppointment) "Nothing"
' currentAppointment.Delete
' Set currentAppointment = myAppointments.FindNext
'Wend
'^^^^^^^^^^^^^^^^^^DELETE^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'----------Open schedule.txt file and read it storing values in
strLine------------
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("C:\Schedule.txt")
Set strBodyText = f.OpenAsTextStream(ForReading, TristateFalse)
s = strBodyText.ReadAll
nCount = strBodyText.Count


Set onMapi = GetNamespace("MAPI")

If MsgBox("Will you currently be importing offline?", 3) = vbYes Then
If MsgBox("Will you be importing to a subfolder of the root
Calendar?", 3) = vbYes Then
Title = "Import Schedule (Working Offline)"
Message = "Please supply me with the name of your Root
Calendar Folder:"
Default = "Calendar"
MyValue = InputBox(Message, Title, Default)
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue).Folders(MyValue2)
Else
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue2)
End If


Else
Set ofFolder = onMapi.PickFolder
End If


If ofFolder Is Nothing Then
MsgBox "No Folder Selected, User Cancelled"
Else
MsgBox "Folder - " & ofFolder.Name & " was selected by the user"
Set myAppointments = ofFolder.Items
'/////////Need to get the start and end date of the report
strMsg = ""
intAdded = 0
strStart = ""

CRLF = ":::*" '---------------------Carrige Return Line Feed
CRTEST = ","
'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
intTxtStartDate = ""
intTxtEndDate = ""
intExchVariable = ""

strStart = ""
strEnd = ""
strExchangeVariable = ""

If intBreak 0 Then
Do Until intBreak = 0
strLine = Mid(s, intStart, intBreak - intStart)

If strLine "" Then
If intStart = 1 Then
intTxtStartDate = InStr(1, strLine,
CRTEST) '1ST COMMA start of the report
intTxtEndDate = InStr(intTxtStartDate +
1, strLine, CRTEST) '2ND COMMA end of report start time
intExchVariable = InStr(intTxtEndDate +
1, strLine, CRTEST) '3RD COMMA end of report start time
intExchVariableEnd =
InStr(intExchVariable + 1, strLine, CRTEST) 'end of report

strStart = Mid(strLine, intTxtStartDate
+ 1, intTxtEndDate - (intTxtStartDate + 1)) + " 00:00:00 AM"
strEnd = Mid(strLine, intTxtEndDate + 1,
intExchVariable - (intTxtEndDate + 1)) + " 23:59:00 PM"
strExchangeVariable = Mid(strLine,
intExchVariable + 1, intBreak - (intTest + 4))


End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)

Loop
End If
'////////////////

strExchNewVariable = "[Categories] = """ + strExchangeVariable +
""""
Set currentAppointment = myAppointments.Find(strExchNewVariable)


While TypeName(currentAppointment) "Nothing"
strCalStart = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strCalEnd = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strTextStart = FormatDateTime(strStart, vbGeneralDate)
strTextEnd = FormatDateTime(strEnd, vbGeneralDate)

If ((DateValue(strCalStart) = DateValue(strTextStart)) And
(DateValue(strCalEnd) = DateValue(strTextEnd))) Then
currentAppointment.Delete
End If

Set currentAppointment = myAppointments.FindNext
Wend
End If



CRLF = ":::*" '---------------------Carrige Return Line Feed

strMsg = ""
intAdded = 0

'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
If intBreak 0 Then
Do Until intBreak = 0

strLine = Mid(s, intStart, intBreak - intStart)
strNoLine = InStr(1, strLine, "Nothing")


If strLine "" Then
'Do not want to bring in the 1st line, it now has the
start and enddate of report
If strNoLine = 0 Then
strResult = AddAppt(strLine, ofFolder)
'Sends values to AddAppt Function
strMsg = strMsg & CRLF & strResult
intAdded = intAdded + 1
End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)
Loop
End If
'----------Open schedule.txt file and read it storing values in
strLine------------
'Else
' Exit Sub
End If
f.Delete 'Deletes saved file from C:\
myItem.Close (olDiscard) 'Closes the Inspector window
End Sub

Function AddAppt(strParams, ofFolder)

Dim objAppt As AppointmentItem
Dim arrParams
Dim varStart
Dim strMsg
Dim StartDate, EndDate
Dim check

On Error Resume Next

Set objAppt = ofFolder.Items.Add(olAppointmentItem)



'Set objAppt = Application.CreateItem(olAppointmentItem)


'This function will only work in VBScript 2.0 and later


arrParams = Split(strParams, ",") 'Reads the commas out of the file.
objAppt.Subject = arrParams(0)

'Determine whether an all day event or not
objAppt.AllDayEvent = arrParams(5)

If objAppt.AllDayEvent = True Then
'treats all-day events as single day
varStart = CDate(arrParams(1) & " 12:00 AM")
objAppt.Start = varStart
Else
objAppt.Start = arrParams(1) & " " & arrParams(2)
objAppt.End = arrParams(3) & " " & arrParams(4)

End If

objAppt.ReminderSet = arrParams(6)
If objAppt.ReminderSet = True Then
objAppt.ReminderMinutesBeforeStart = _
DateDiff("m", arrParams(7) & " " & arrParams(8), objAppt.Start)
End If
objAppt.Categories = arrParams(9)
objAppt.Body = arrParams(10)
objAppt.Location = arrParams(11)


objAppt.Save

The error suggests that ActiveInspector returns Nothing, in other words, that you do not have any item open in its own window when you run the code.

Also note that you should never use this statement in Outlook VBA:

Set myOlApp = CreateObject("Outlook.Application")

Instead, either use this statement:

Set myOlApp = Application

or remove that statement completely and replace myOlApp with the intrinsic Application object.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"Bravadarose" wrote in message ...
When I run it I get a Run-time error '91': Object variable or With block
variable not set. I go into debug and it Highlights this line:

Set myItem = myOlApp.ActiveInspector.CurrentItem

I have a macro that works in Outlook 2003; however, it no longer works in
2007. A .cvs file is attached to an email and the macro is to put the
information from this file into the Outlook Calendar. It should delete
previous calendar entries within the same date range and replace with what is
in the new file. Could someone please help me convert my macro for 2007?

Below is my current code:


Sub ImportSchedule()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Dim myOlApp
Dim myItem
Dim myAttachments
Dim strBodyText
Dim CRLF
Dim CRTEST
Dim intTxtStartDate, intTxtEndDate, intExchVariable
Dim strExchangeVariable
Dim strExchNewVariable
Dim strLine
Dim intStart
Dim intBreak
Dim strMsg
Dim intAdded
Dim intFirstDate
Dim strResult
Dim sFoldername As String
Dim objPage
Dim fs As Object
Dim s, n
Dim AttachName As String
Dim objAppt
Dim myNameSpace
Dim arrParams
Dim myOlApplic
Dim myAppointments
Dim currentAppointment
Dim onMapi As NameSpace
Dim ofFolder As MAPIFolder
Dim Message, Title, Default, MyValue, Style
Dim Message2, Title2, Default2, MyValue2
Dim strStart, strEnd, nCount
Dim strCalStart, strCalEnd, strTextStart, strTextEnd


'------------Check Attachment to see if it's schedule.txt---------
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set myAttachments = myItem.Attachments
On Error Resume Next
AttachName = myAttachments.Item(1).DisplayName

If AttachName = "Schedule.txt" Then
myAttachments.Item(1).SaveAsFile "C:\" & _
myAttachments.Item(1).DisplayName

intFirstDate = 1
'^^^^^^^^^^^^Check Attachment to see if it's schedule.txt^^^^^^^^^

'---------------DELETE--------------------------------------------
'Set myOlApplic = CreateObject("Outlook.Application")
'Set myNameSpace = myOlApplic.GetNamespace("MAPI")
'Set myAppointments = myNameSpace.GetDefaultFolder _
' (olFolderCalendar).Items
'Set currentAppointment = myAppointments.Find("[Categories] = ""Staff Trak""")

'While TypeName(currentAppointment) "Nothing"
' currentAppointment.Delete
' Set currentAppointment = myAppointments.FindNext
'Wend
'^^^^^^^^^^^^^^^^^^DELETE^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'----------Open schedule.txt file and read it storing values in
strLine------------
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile("C:\Schedule.txt")
Set strBodyText = f.OpenAsTextStream(ForReading, TristateFalse)
s = strBodyText.ReadAll
nCount = strBodyText.Count


Set onMapi = GetNamespace("MAPI")

If MsgBox("Will you currently be importing offline?", 3) = vbYes Then
If MsgBox("Will you be importing to a subfolder of the root
Calendar?", 3) = vbYes Then
Title = "Import Schedule (Working Offline)"
Message = "Please supply me with the name of your Root
Calendar Folder:"
Default = "Calendar"
MyValue = InputBox(Message, Title, Default)
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue).Folders(MyValue2)
Else
Message2 = "Please supply me with the name of the Calander
you wish to import to:"
Title2 = "Import Schedule (Working Offline)"
Default2 = "Calendar"
MyValue2 = InputBox(Message2, Title2, Default2)
Set ofFolder = onMapi.Folders("Personal
Folders").Folders(MyValue2)
End If


Else
Set ofFolder = onMapi.PickFolder
End If


If ofFolder Is Nothing Then
MsgBox "No Folder Selected, User Cancelled"
Else
MsgBox "Folder - " & ofFolder.Name & " was selected by the user"
Set myAppointments = ofFolder.Items
'/////////Need to get the start and end date of the report
strMsg = ""
intAdded = 0
strStart = ""

CRLF = ":::*" '---------------------Carrige Return Line Feed
CRTEST = ","
'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
intTxtStartDate = ""
intTxtEndDate = ""
intExchVariable = ""

strStart = ""
strEnd = ""
strExchangeVariable = ""

If intBreak 0 Then
Do Until intBreak = 0
strLine = Mid(s, intStart, intBreak - intStart)

If strLine "" Then
If intStart = 1 Then
intTxtStartDate = InStr(1, strLine,
CRTEST) '1ST COMMA start of the report
intTxtEndDate = InStr(intTxtStartDate +
1, strLine, CRTEST) '2ND COMMA end of report start time
intExchVariable = InStr(intTxtEndDate +
1, strLine, CRTEST) '3RD COMMA end of report start time
intExchVariableEnd =
InStr(intExchVariable + 1, strLine, CRTEST) 'end of report

strStart = Mid(strLine, intTxtStartDate
+ 1, intTxtEndDate - (intTxtStartDate + 1)) + " 00:00:00 AM"
strEnd = Mid(strLine, intTxtEndDate + 1,
intExchVariable - (intTxtEndDate + 1)) + " 23:59:00 PM"
strExchangeVariable = Mid(strLine,
intExchVariable + 1, intBreak - (intTest + 4))


End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)

Loop
End If
'////////////////

strExchNewVariable = "[Categories] = """ + strExchangeVariable +
""""
Set currentAppointment = myAppointments.Find(strExchNewVariable)


While TypeName(currentAppointment) "Nothing"
strCalStart = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strCalEnd = FormatDateTime(currentAppointment.Start,
vbGeneralDate)
strTextStart = FormatDateTime(strStart, vbGeneralDate)
strTextEnd = FormatDateTime(strEnd, vbGeneralDate)

If ((DateValue(strCalStart) = DateValue(strTextStart)) And
(DateValue(strCalEnd) = DateValue(strTextEnd))) Then
currentAppointment.Delete
End If

Set currentAppointment = myAppointments.FindNext
Wend
End If



CRLF = ":::*" '---------------------Carrige Return Line Feed

strMsg = ""
intAdded = 0

'Get the first line of the paramaters
intStart = 1
intBreak = InStr(intStart, s, CRLF)
If intBreak 0 Then
Do Until intBreak = 0

strLine = Mid(s, intStart, intBreak - intStart)
strNoLine = InStr(1, strLine, "Nothing")


If strLine "" Then
'Do not want to bring in the 1st line, it now has the
start and enddate of report
If strNoLine = 0 Then
strResult = AddAppt(strLine, ofFolder)
'Sends values to AddAppt Function
strMsg = strMsg & CRLF & strResult
intAdded = intAdded + 1
End If

Else
'exit at first blank line
Exit Do
End If

intStart = intBreak + 4
intBreak = InStr(intStart, s, CRLF)
Loop
End If
'----------Open schedule.txt file and read it storing values in
strLine------------
'Else
' Exit Sub
End If
f.Delete 'Deletes saved file from C:\
myItem.Close (olDiscard) 'Closes the Inspector window
End Sub

Function AddAppt(strParams, ofFolder)

Dim objAppt As AppointmentItem
Dim arrParams
Dim varStart
Dim strMsg
Dim StartDate, EndDate
Dim check

On Error Resume Next

Set objAppt = ofFolder.Items.Add(olAppointmentItem)



'Set objAppt = Application.CreateItem(olAppointmentItem)


'This function will only work in VBScript 2.0 and later


arrParams = Split(strParams, ",") 'Reads the commas out of the file.
objAppt.Subject = arrParams(0)

'Determine whether an all day event or not
objAppt.AllDayEvent = arrParams(5)

If objAppt.AllDayEvent = True Then
'treats all-day events as single day
varStart = CDate(arrParams(1) & " 12:00 AM")
objAppt.Start = varStart
Else
objAppt.Start = arrParams(1) & " " & arrParams(2)
objAppt.End = arrParams(3) & " " & arrParams(4)

End If

objAppt.ReminderSet = arrParams(6)
If objAppt.ReminderSet = True Then
objAppt.ReminderMinutesBeforeStart = _
DateDiff("m", arrParams(7) & " " & arrParams(8), objAppt.Start)
End If
objAppt.Categories = arrParams(9)
objAppt.Body = arrParams(10)
objAppt.Location = arrParams(11)


objAppt.Save