will_scarlet7
asked on
Multiple step OLE DB error
Hi Experts,
I have a database that I have been using to compile work reports from 4 sources monthly. The reports come in as .mdb files named with a prefix for the user sending the report, the report name & month the report is for (example: prefix= "KN", report = "chk", month= "Aug" > Filename = "KNchkAug.mdb"). Then inside each file contains a set of tables having a standard set of names except that each tablename begins with the prefix for the user that sent it in like this, KN_Checklist.
All was working fine until I decided it needed to be improved for timing sake. My front end has a form that I enter the current month and the user to import from and then I was using "DoCmd.TransferDatabase acLink" to update the link to the correct workreport BE, after which I would run append queries to compile the data as needed. Since upgrading to Access 2003 however the "TransferDatabase" method has been noticably slower than it used to be in previous versions (taking up to 3 seconds per linked table). So I decided to look for a better method and this is where my problem arrived. Here is the code I am trying to work with:
'*************************
Function RefreshLink(newBE As String, newPrefix As String)
Dim cat As Object
Dim tbl As Object
Dim oldNM As String
Set cn = CreateObject("Adodb.Connec
Set cat = CreateObject("ADOX.Catalog
Set tbl = CreateObject("ADOX.Table")
cat.ActiveConnection = CurrentProject.Connection 'cn
For Each tbl In cat.Tables
If tbl.Type = "LINK" Then
'mytbprop = tbl.Properties
oldNM = tbl.Properties("Jet OLEDB:Remote Table Name")
oldNM = Right(oldNM, Len(oldNM) - 2)
With tbl
.Properties("Jet OLEDB:Remote Table Name") = newPrefix & oldNM
.Properties("Jet OLEDB:Link Datasource") = newBE
End With
End If
Next
Set cat = Nothing
Set tbl = Nothing
End Function
'*************************
when the function hits ".Properties("Jet OLEDB:Remote Table Name") = newPrefix & oldNM" I get the following error:
Run-time error '2147217887 (80040e21)':
Multiple step OLE DB opperation generated errors. Check each OLE DB
status value, if available. No work was done
Any help? I have little time to work on this today, so maximum points.
TIA!
Sam
I have a database that I have been using to compile work reports from 4 sources monthly. The reports come in as .mdb files named with a prefix for the user sending the report, the report name & month the report is for (example: prefix= "KN", report = "chk", month= "Aug" > Filename = "KNchkAug.mdb"). Then inside each file contains a set of tables having a standard set of names except that each tablename begins with the prefix for the user that sent it in like this, KN_Checklist.
All was working fine until I decided it needed to be improved for timing sake. My front end has a form that I enter the current month and the user to import from and then I was using "DoCmd.TransferDatabase acLink" to update the link to the correct workreport BE, after which I would run append queries to compile the data as needed. Since upgrading to Access 2003 however the "TransferDatabase" method has been noticably slower than it used to be in previous versions (taking up to 3 seconds per linked table). So I decided to look for a better method and this is where my problem arrived. Here is the code I am trying to work with:
'*************************
Function RefreshLink(newBE As String, newPrefix As String)
Dim cat As Object
Dim tbl As Object
Dim oldNM As String
Set cn = CreateObject("Adodb.Connec
Set cat = CreateObject("ADOX.Catalog
Set tbl = CreateObject("ADOX.Table")
cat.ActiveConnection = CurrentProject.Connection 'cn
For Each tbl In cat.Tables
If tbl.Type = "LINK" Then
'mytbprop = tbl.Properties
oldNM = tbl.Properties("Jet OLEDB:Remote Table Name")
oldNM = Right(oldNM, Len(oldNM) - 2)
With tbl
.Properties("Jet OLEDB:Remote Table Name") = newPrefix & oldNM
.Properties("Jet OLEDB:Link Datasource") = newBE
End With
End If
Next
Set cat = Nothing
Set tbl = Nothing
End Function
'*************************
when the function hits ".Properties("Jet OLEDB:Remote Table Name") = newPrefix & oldNM" I get the following error:
Run-time error '2147217887 (80040e21)':
Multiple step OLE DB opperation generated errors. Check each OLE DB
status value, if available. No work was done
Any help? I have little time to work on this today, so maximum points.
TIA!
Sam
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Does it work if you swap around the Link Datasource and Remote Table Name lines? I'm not terribly familiar with ADOX.
ASKER
It causes the same error.
:( I could tell you how to do with DAO, but I'm not sure if that would be any faster.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you both, Sane & LSM!
I think the problem lies in that the ".Properties("Jet OLEDB:Remote Table Name")" must be a read only property once the link is made. So nice of our dear Microsoft to just give generalities in their error message...
What I opted for was a change in tactic. The code below moves through a recordset to get the old link name and delete it then import a new link to the current BE.
Sub CreateLinkedTableADO(dbBE As String)
Dim cat As Object
Dim rs As Object
Dim tbl As Object
Dim strSQL As String
Set cn = CreateObject("Adodb.Connec
Set rs = CreateObject("Adodb.Record
Set cat = CreateObject("ADOX.Catalog
Set tbl = CreateObject("ADOX.Table")
cat.ActiveConnection = CurrentProject.Connection
strSQL = "SELECT * FROM stpLinkedTables WHERE stpLinkedTables.Category = 'ABM';"
rs.Open strSQL, CurrentProject.Connection,
rs.MoveFirst
While Not rs.EOF
DoCmd.DeleteObject acTable, rs("LinkName")
Set tbl = New ADOX.Table
Set tbl.ParentCatalog = cat
With tbl
.Name = rs("LinkName")
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Remote Table Name") = rs("TableName")
.Properties("Jet OLEDB:Link Datasource") = dbBE
End With
cat.Tables.Append tbl
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set cat = Nothing
Set tbl = Nothing
End Sub
Seems to be working good so far (and ten times faster than the TransferDatabase method).
All your help was appreciated. Are you OK if I split the points between you with a grade of "B"? I'd rather do that then have the question PAQ'd since I don't need the points refunded. Let me know your preference.
God bless!
Sam
I think the problem lies in that the ".Properties("Jet OLEDB:Remote Table Name")" must be a read only property once the link is made. So nice of our dear Microsoft to just give generalities in their error message...
What I opted for was a change in tactic. The code below moves through a recordset to get the old link name and delete it then import a new link to the current BE.
Sub CreateLinkedTableADO(dbBE As String)
Dim cat As Object
Dim rs As Object
Dim tbl As Object
Dim strSQL As String
Set cn = CreateObject("Adodb.Connec
Set rs = CreateObject("Adodb.Record
Set cat = CreateObject("ADOX.Catalog
Set tbl = CreateObject("ADOX.Table")
cat.ActiveConnection = CurrentProject.Connection
strSQL = "SELECT * FROM stpLinkedTables WHERE stpLinkedTables.Category = 'ABM';"
rs.Open strSQL, CurrentProject.Connection,
rs.MoveFirst
While Not rs.EOF
DoCmd.DeleteObject acTable, rs("LinkName")
Set tbl = New ADOX.Table
Set tbl.ParentCatalog = cat
With tbl
.Name = rs("LinkName")
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Remote Table Name") = rs("TableName")
.Properties("Jet OLEDB:Link Datasource") = dbBE
End With
cat.Tables.Append tbl
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Set cat = Nothing
Set tbl = Nothing
End Sub
Seems to be working good so far (and ten times faster than the TransferDatabase method).
All your help was appreciated. Are you OK if I split the points between you with a grade of "B"? I'd rather do that then have the question PAQ'd since I don't need the points refunded. Let me know your preference.
God bless!
Sam
> Sane & LSM!
Sane I am not :) It's ok by me, Sam but I'll leave it up to you.
Sane I am not :) It's ok by me, Sam but I'll leave it up to you.
ASKER
Sorry Shane...
ASKER
Any chance I can post a second question about the above code (not @ ADO) here and you answer that way I can award an A for the answer? Or should I close this one and open a new one?
I don't mind either way Sam, so long as I can help :)
ASKER
I'll close this with a "B" and open a new one (more points available to be earned that way)
ThanX again!
Sam
ThanX again!
Sam
ASKER
ASKER