slang
08-18-2011, 08:43 AM
I am migrating over to new tablet pc's and to office 2010 and the following code now hangs with the message Run time 2147221227 (80040115)
connection to microsoft exchange is unavailable, outlook must be online or connected to complete this action.
Outlook is set to enable offline mode and the email script still works.
Anything appear to be wrong with the code for 2010?:dunno
Thanks...
Sub Tasks()
Const olAppointmentItem As Long = 1
Const olTaskItem As Long = 3
Dim olApp As Object
Dim OLNS As Object
Dim OLTask As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If Not olApp Is Nothing Then
Set OLNS = olApp.GetNamespace("MAPI")
OLNS.Logon
Set OLTask = olApp.CreateItem(olTaskItem)
OLTask.Subject = Sheets("Visit Types").Range("b31").Value
OLTask.Body = Sheets("Visit Types").Range("b32").Value
OLTask.StartDate = Sheets("Visit Types").Range("b33").Value
OLTask.DueDate = Sheets("Visit Types").Range("b34").Value
OLTask.ReminderTime = Sheets("Visit Types").Range("b35").Value
OLTask.display
OLTask.Save
Set OLTask = Nothing
Set OLNS = Nothing
Set olApp = Nothing
End If
End Sub
connection to microsoft exchange is unavailable, outlook must be online or connected to complete this action.
Outlook is set to enable offline mode and the email script still works.
Anything appear to be wrong with the code for 2010?:dunno
Thanks...
Sub Tasks()
Const olAppointmentItem As Long = 1
Const olTaskItem As Long = 3
Dim olApp As Object
Dim OLNS As Object
Dim OLTask As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If Not olApp Is Nothing Then
Set OLNS = olApp.GetNamespace("MAPI")
OLNS.Logon
Set OLTask = olApp.CreateItem(olTaskItem)
OLTask.Subject = Sheets("Visit Types").Range("b31").Value
OLTask.Body = Sheets("Visit Types").Range("b32").Value
OLTask.StartDate = Sheets("Visit Types").Range("b33").Value
OLTask.DueDate = Sheets("Visit Types").Range("b34").Value
OLTask.ReminderTime = Sheets("Visit Types").Range("b35").Value
OLTask.display
OLTask.Save
Set OLTask = Nothing
Set OLNS = Nothing
Set olApp = Nothing
End If
End Sub