G
Guest
I can connect to a folder in my mailbox, but the same code fails to connect
to a public folder on Exchange.
The .Open instruction generates the following error:
" Runtime error '-2147467259 (80004005)':
Network I/O error. "
My code is below.
Any advice would be gratefully received. TIA
Vaughan
Sub Transfer_Exchange_Minutes()
Dim objOLApp As Outlook.Application
Dim objOLExp As Outlook.Explorer
Const strMinFolderPath = "Public Folders\All Public
Folders\Projects\Project Details\Minutes"
Const strMAPIParentFolder = "Public Folders|All Public
Folders\Projects\Project Details"
Dim ADOOlConn As ADODB.Connection
Dim ADOAcConn As ADODB.Connection
Dim ADOOlRS As ADODB.Recordset
Dim ADOAcRS As ADODB.Recordset
Dim AccRS As ADODB.Recordset
Dim strConn As String
Dim objMinuteFolder As Outlook.MAPIFolder
Dim objOlView As Outlook.View
' On Error GoTo Err_Handler
' Read Outlook data
' -----------------
Set objOLApp = New Outlook.Application
Set objOLExp = objOLApp.ActiveExplorer
With objOLExp
Set .CurrentFolder = GetMapiFolder(strMinFolderPath)
.CurrentView = "Transfer Data"
End With
Set ADOOlConn = New ADODB.Connection
With ADOOlConn
.Provider = "Microsoft.JET.OLEDB.4.0"
.ConnectionString = "Exchange 4.0;" _
& "MAPILEVEL=" & strMAPIParentFolder _
& "Profile=SBSOutlook;" _
& "TABLETYPE=0;" _
& "DATABASE=C:\WINDOWS\TEMP\OLData.mdb;"
.Open ' Error generated on this line
End With
Set ADOOlRS = New ADODB.Recordset
With ADOOlRS
.Open "SELECT [Meeting Description], " _
& " [Job], " _
& " [MeetingDate], " _
& " [Body], " _
& " [ConvInd], " _
& " [AssignedTo], " _
& " [DueDate], " _
& " [MeetingThread], " _
& " [Conversation], " _
& " [Message Class], " _
& " Iif(left([Message Class],8) = 'IPM.NOTE',
[Completed],False) As [Compl] " _
& " FROM Minutes" _
& " WHERE [Message Class] <> 'IPM.Post.Meeting_Header'",
ADOOlConn, adOpenForwardOnly, adLockReadOnly
.MoveFirst
End With
' Connect to Access table
' -----------------------
Set ADOAcConn = New ADODB.Connection
ADOAcConn.Open "DSN=OLTest"
' Loop through items in Exchange recordset updating to Access table
' -----------------------------------------------------------------
Do While Not ADOOlRS.EOF
Set ADOAcRS = New ADODB.Recordset
ADOAcRS.Open "Select * From tbl_Outlook_Minutes", ADOAcConn,
adOpenStatic, adLockOptimistic
ADOAcRS.AddNew
For n = 0 To 10
ADOAcRS(n + 1) = ADOOlRS(n)
Next
ADOAcRS.Update
If Err <> 0 Then
MsgBox "Vaughan's Error Message" & Chr(13) _
& Err.Number & " " & Err.Description & Chr(13) _
& Err.Source
End If
ADOAcRS.Close
Set ADOAcRS = Nothing
ADOOlRS.MoveNext
Loop
ADOAcConn.Close
ADOOlRS.Close
ADOOlConn.Close
Err_Handler:
Set ADOAcRS = Nothing
Set ADOAcConn = Nothing
Set ADOOlRS = Nothing
Set ADOOlConn = Nothing
End Sub
to a public folder on Exchange.
The .Open instruction generates the following error:
" Runtime error '-2147467259 (80004005)':
Network I/O error. "
My code is below.
Any advice would be gratefully received. TIA
Vaughan
Sub Transfer_Exchange_Minutes()
Dim objOLApp As Outlook.Application
Dim objOLExp As Outlook.Explorer
Const strMinFolderPath = "Public Folders\All Public
Folders\Projects\Project Details\Minutes"
Const strMAPIParentFolder = "Public Folders|All Public
Folders\Projects\Project Details"
Dim ADOOlConn As ADODB.Connection
Dim ADOAcConn As ADODB.Connection
Dim ADOOlRS As ADODB.Recordset
Dim ADOAcRS As ADODB.Recordset
Dim AccRS As ADODB.Recordset
Dim strConn As String
Dim objMinuteFolder As Outlook.MAPIFolder
Dim objOlView As Outlook.View
' On Error GoTo Err_Handler
' Read Outlook data
' -----------------
Set objOLApp = New Outlook.Application
Set objOLExp = objOLApp.ActiveExplorer
With objOLExp
Set .CurrentFolder = GetMapiFolder(strMinFolderPath)
.CurrentView = "Transfer Data"
End With
Set ADOOlConn = New ADODB.Connection
With ADOOlConn
.Provider = "Microsoft.JET.OLEDB.4.0"
.ConnectionString = "Exchange 4.0;" _
& "MAPILEVEL=" & strMAPIParentFolder _
& "Profile=SBSOutlook;" _
& "TABLETYPE=0;" _
& "DATABASE=C:\WINDOWS\TEMP\OLData.mdb;"
.Open ' Error generated on this line
End With
Set ADOOlRS = New ADODB.Recordset
With ADOOlRS
.Open "SELECT [Meeting Description], " _
& " [Job], " _
& " [MeetingDate], " _
& " [Body], " _
& " [ConvInd], " _
& " [AssignedTo], " _
& " [DueDate], " _
& " [MeetingThread], " _
& " [Conversation], " _
& " [Message Class], " _
& " Iif(left([Message Class],8) = 'IPM.NOTE',
[Completed],False) As [Compl] " _
& " FROM Minutes" _
& " WHERE [Message Class] <> 'IPM.Post.Meeting_Header'",
ADOOlConn, adOpenForwardOnly, adLockReadOnly
.MoveFirst
End With
' Connect to Access table
' -----------------------
Set ADOAcConn = New ADODB.Connection
ADOAcConn.Open "DSN=OLTest"
' Loop through items in Exchange recordset updating to Access table
' -----------------------------------------------------------------
Do While Not ADOOlRS.EOF
Set ADOAcRS = New ADODB.Recordset
ADOAcRS.Open "Select * From tbl_Outlook_Minutes", ADOAcConn,
adOpenStatic, adLockOptimistic
ADOAcRS.AddNew
For n = 0 To 10
ADOAcRS(n + 1) = ADOOlRS(n)
Next
ADOAcRS.Update
If Err <> 0 Then
MsgBox "Vaughan's Error Message" & Chr(13) _
& Err.Number & " " & Err.Description & Chr(13) _
& Err.Source
End If
ADOAcRS.Close
Set ADOAcRS = Nothing
ADOOlRS.MoveNext
Loop
ADOAcConn.Close
ADOOlRS.Close
ADOOlConn.Close
Err_Handler:
Set ADOAcRS = Nothing
Set ADOAcConn = Nothing
Set ADOOlRS = Nothing
Set ADOOlConn = Nothing
End Sub