ms access - Linking tables through vba -

ms access - Linking tables through vba -

i completing task has been assigned me colleagues in usa (i'm based in uk). database application uses linked tables microsoft access database file on network has been encrypted stores client information.

there no colleague on usa side similar skill set create alterations database locations through vba. have seen various methods connect sql databases shown on microsoft link below. however, create easier alter location of database.

is possible ammend below code @ text file house location of database end (c:\users\public\test1) illustration , link tables front end end.

i have found code below errors out saying "object msysaccessstorage exists". errors out on line "currentdb.tabledefs.append tdf".

option explicit dim dbs dao.database dim tdf dao.tabledef dim mypass string dim mypath string dim mydb string dim tablename string function connectme() mypass = "test1" mypath = "c:\users\test1\desktop\" mydb = "em1.accdb" ' delete links there won't duplicates each tdf in currentdb.tabledefs if left(tdf.name, 4) <> "msys" , left(tdf.name, 15) <> "tblreportsstate" , _ (tdf.attributes , dbattachedtable) = dbattachedtable currentdb.tabledefs.delete tdf.name end if next tdf set tdf = nil ' setup links set dbs = opendatabase(mypath & mydb, false, false, "ms access;pwd=" & mypass) each tdf in dbs.tabledefs if left(tdf.name, 4) <> "msys" tablename = tdf.name set tdf = currentdb.createtabledef(tablename) tdf.connect = ";pwd=" & mypass & ";database=" + mypath + mydb tdf.sourcetablename = tablename currentdb.tabledefs.append tdf end if next end function

you getting error because access' tabledefs list not reflect changes make, i.e. delete. can refresh currentdb.tabledefs.refresh after .appends and/or .deletes, takes time, , considering refreshing linked tables takes important amount of time each, time may not able afford.

it improve practice check tabledefs pre-existing links , refresh them, not delete , recreate them, deleting them deletes formatting, such column widths , field formats refresh leave unchanged.

if have tables need links refreshed, alter .connect property, utilize currentdb.tabledefs(tablename).refreshlink

you should using currentdb.tabledefs.delete tdf.name when source table no longer exists.

i utilize method similar myself, store date , time of lastly linked table refresh, , refresh tables had schema modified after time. hundred or more table links , 2+ seconds per table refresh links, need save time can.

edit:

the next code code utilize perform similar task linking ms access sql server.

disclaimer: next code provided as-is, , will not work pure access front-end/back-end situation. will necessary modify suit needs.

public sub refreshlinkedtables() dim adoconn adodb.connection dim arsqlobjects adodb.recordset dim createlink boolean, updatelink boolean, found boolean dim dws dao.workspace dim ddb dao.database dim drsqlschemas dao.recordset, drsysvars dao.recordset, drmso dao.recordset dim dtdef dao.tabledef dim objecttime date dim ststart double, stend double, tstart double, tend double dim ctra long, errno long dim descstr string, sqlstr string, connstr string dim sqlobjects() string ststart = perftimer() set dws = dbengine.workspaces(0) set ddb = dws.databases(0) set drsysvars = ddb.openrecordset("tbl_sysvars", dbopendynaset) if drsysvars.recordcount = 0 exit sub appendtxtmain "refreshing links """ & drsysvars![servername] & """: """ & drsysvars![database] & """ @ " & format(now, "hh:mm:ss ampm"), true set adoconn = sqlconnection() set arsqlobjects = new adodb.recordset sqlstr = "select sys.schemas.name [schema], sys.objects.*, sys.schemas.name + '.' + sys.objects.name soname " & _ "from sys.objects inner bring together sys.schemas on sys.objects.schema_id = sys.schemas.schema_id " & _ "where (sys.objects.type in ('u', 'v')) , (sys.objects.is_ms_shipped = 0) " & _ "order soname" objecttime = now() arsqlobjects.open sqlstr, adoconn, adopenstatic, adlockreadonly, adcmdtext set drsqlschemas = dws.databases(0).openrecordset("select * usys_tbl_sqlschemas linkobjects = true", dbopendynaset) set drmso = dws.databases(0).openrecordset("select name msysobjects type in(1,4,6) order name", dbopensnapshot) redim sqlobjects(0 arsqlobjects.recordcount - 1) arsqlobjects drmso.movefirst if not .eof .movelast .movefirst end if prgprogress.max = .recordcount prgprogress = 0 ctra = 0 connstr = "driver={sql server native client 10.0};server=" & drsysvars![servername] & ";database=" & drsysvars![database] if nz(drsysvars![username]) = "" connstr = connstr & ";trusted_connection=yes" else connstr = connstr & ";uid=" & drsysvars![username] & ";pwd=" & drsysvars![password] & ";" end if until .eof tstart = perftimer sqlobjects(ctra) = arsqlobjects![schema] & "_" & arsqlobjects![name] appendtxtmain ![soname] & " (" & ![modify_date] & "): ", true drsqlschemas.findfirst "[schemaid] = " & ![schema_id] if not drsqlschemas.nomatch updatelink = false createlink = false drmso.findfirst "name=""" & drsqlschemas![schemaname] & "_" & arsqlobjects![name] & """" if drmso.nomatch createlink = true appendtxtmain "adding link... " set dtdef = ddb.createtabledef(arsqlobjects![schema] & "_" & arsqlobjects![name], dbattachsavepwd, ![soname], "odbc;" & connstr) ddb.tabledefs.append dtdef ddb.tabledefs(dtdef.name).properties.append dtdef.createproperty("description", dbtext, "«autolink»") elseif ![modify_date] >= nz(drsysvars![schemaupdated], #1/1/1900#) or regexmatches(ddb.tabledefs(arsqlobjects![schema] & "_" & arsqlobjects![name]).connect, "server=(.+?);")(0).submatches(0) <> drsysvars![servername] _ or (ddb.tabledefs(arsqlobjects![schema] & "_" & arsqlobjects![name]).attributes , dbattachsavepwd) <> dbattachsavepwd updatelink = true appendtxtmain "refreshing link... " ddb.tabledefs(arsqlobjects![schema] & "_" & arsqlobjects![name]) .attributes = dbattachsavepwd .connect = "odbc;" & connstr .refreshlink end end if end if tend = perftimer() appendtxtmain splittime(tend - tstart, 7, "s") .movenext prgprogress = prgprogress + 1 ctra = ctra + 1 loop end prgprogress = 0 prgprogress.max = ddb.tabledefs.count doevents ddb.tabledefs.refresh tstart = perftimer() appendtxtmain "deleting obsolete linked tables, started " & now() & "...", true each dtdef in ddb.tabledefs if dtdef.connect <> "" ' linked table... on error resume next descstr = dtdef.properties("description") errno = err.number on error goto 0 select case errno case 3270 ' property not exist ' nothing. case 0 ' has description. if regex(descstr, "«autolink»") ' description includes "«autolink»" found = false ctra = 0 ubound(sqlobjects) if sqlobjects(ctra) = dtdef.name found = true exit end if next if not found ' delete if not in arsqlobjects appendtxtmain "deleting """ & dtdef.name & """", true ddb.tabledefs.delete dtdef.name end if end if end select end if prgprogress = prgprogress + 1 next tend = perftimer() appendtxtmain "completed @ " & now() & " in " & splittime(tend - tstart, 7, "s"), true drsysvars.edit drsysvars![schemaupdated] = objecttime drsysvars.update drsqlschemas.close ddb.tabledefs.refresh application.refreshdatabasewindow set drsqlschemas = nil arsqlobjects.close set arsqlobjects = nil adoconn.close set adoconn = nil drsysvars.close set drsysvars = nil drmso.close set drmso = nil ddb.close set ddb = nil dws.close set dws = nil prgprogress = 0 end sub

vba ms-access ms-access-2007