Run-time error -214721717911

[incagold]

Good morning all,

Newbie back with another request for help. I am trying to link to a table in a second database to obtain data for populating a table in the current db. I am getting an error -2147217911 when I run that tells me "Could not create; no modify design permission for table or query 'PO_LN';" I have tried everything in my limited knowledge without being able to resolve the problem. I have checked the permissions to the database and the tables and they all are set to modify design and update
I have attached the code below. I appreciate any help and suggestions you can provide.

EAF


Option Explicit
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim adox_catalog As ADOX.Catalog
Dim adox_table As ADOX.Table
Dim app_path As String
'=======================================================================
Public Sub ConnectDBS()
Dim db_file As String
'*** Find the application path
app_path = App.Path
If Right$(app_path, 1) <> "\" Then app_path = app_path & "\"
'*** Open connection to BE_DB.mdb
db_file = app_path & "BE_DB.mdb"
Set conn = New ADODB.Connection 'BE_DB.mdb
conn.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & db_file & ";" & _
"Persist Security Info=False"
conn.Open
'*** Test connection for success
If conn.State <> adStateOpen Then
MsgBox "Sorry. The Connection to BE_DB db could NOT be made!!!"
conn.Close
Exit Sub
End If
'*** Establish catalog
Set adox_catalog = New ADOX.Catalog
Set adox_catalog.ActiveConnection = conn
End Sub
'=======================================================================
Sub LoadCP()
'*** Load Table CP from Table PO_LN
Dim strSQL As String
'*** Link to XFER PO_LN table
Set adox_table = New ADOX.Table
With adox_table
Set .ParentCatalog = adox_catalog
.Name = "RE_PO_LN"
.Properties("Jet OLEDB:Link Datasource") = app_path _
& "XFER.mdb"
.Properties("Jet OLEDB:Link Provider String") = "MS Access"
.Properties("Jet OLEDB:Remote Table Name") = "PO_LN"
.Properties("Jet OLEDB:Create Link") = True
End With
'*** Add PO_LN table to Tables Collection


adox_catalog.Tables.Append adox_table '<<<<< ERROR TRIGGERED HERE


'*** POPULATE CP TABLE
strSQL = ""
strSQL = strSQL & "INSERT INTO CP "
strSQL = strSQL & "( PART_NO, MTD, BLOCK, DESCRIPTION, PO_ID, "
strSQL = strSQL & "PO_LN_KEY, SER_NO, SITE_NO, INVT_ABBRV_CD, "
strSQL = strSQL & "PROJ_ID, O_QTY, A_QTY, V_QTY, ORD_DT, DUE_DT, "
strSQL = strSQL & "NET_UNIT_CST_AMT, CST_AMT_PCT_RT, V_CST, "
strSQL = strSQL & "RQ_ID, ITEM_RVSN_ID, BUYER_ID, LAST_NAME, "
strSQL = strSQL & "VEND_ID, VEND_NAME, PT_REC_ID, IACC, SERNOC, "
strSQL = strSQL & "PROCURE_TYPE_CD ) "
strSQL = strSQL & "SELECT PART_NO, MTD, BLOCK, DESCRIPTION, "
strSQL = strSQL & "Trim(PO_ID), PO_LN_KEY, SER_NO, SITE_NO, "
strSQL = strSQL & "INVT_ABBRV_CD, PROJ_ID, O_QTY, A_QTY, V_QTY, "
strSQL = strSQL & "ORD_DT, DUE_DT, NET_UNIT_CST_AMT, "
strSQL = strSQL & "CST_AMT_PCT_RT, V_AMT AS V_CST, Trim(RQ_ID), "
strSQL = strSQL & "ITEM_RVSN_ID, BUYER_ID, LAST_NAME, VEND_ID, "
strSQL = strSQL & "VEND_NAME, Null AS PT_REC_ID, IACC, SERNOC, "
strSQL = strSQL & "PROCURE_TYPE_CD "
strSQL = strSQL & "FROM RE_PO_LN "
strSQL = strSQL & "ORDER BY PART_NO, MTD, BLOCK, SER_NO;"
conn.Execute strSQL
'*** Delete link to PO_LN
adox_catalog.Tables.Delete "RE_PO_LN"
Set adox_table = Nothing
End Sub
'=======================================================================
'=======================================================================

 

[bboffin]

I'm pretty sure that you'll need to create a second ADO connection object to the database that you're trying to create.

conn is connected to BE_DB.mdb so when you use that as the active connection you can't create another .mdb file.

Try that approach and see if it helps

 

[incagold]

hi bboffin,

Thank you for the reply. I am brand new to ado and have been given an exercise that needs to be completed quickly. The person who used to do this has left us and I am really lost. I will try your suggestion and hope that it helps. Thank you again for taking the time to reply.

EAF

 

[Droops]

Hi,

is the remote database (XFER.MDB) password protected ?

If so, you would have to mention it in the :

.Properties("Jet OLEDB:Link Provider String") = "MS Access"

turning it into something like :

.Properties("Jet OLEDB:Link Provider String") = "MS Access;Pwd=myLinkPassword"

Droops