vba - Fix link on-the-fly as an Error handle for error 3044 or more -

vba - Fix link on-the-fly as an Error handle for error 3044 or more -

i have massive set of linked databases have potential move. luckily in 1 working directory of nested folders.

i have created module has path of working folder defined. strworkingfolder

now vba of main command center remains intact multiple calls running , executing queries (append, delete, insert) etc. except each of databases still linked old folder.

i figured whenever error 3044 (not sure of exact verbiage "the path table not exist), relink right path - because known: strworkingfolder (concatenated whatever nested folder database in)

i thought away linked tables, apparently, need re-link kinds of files: csv, excel, accdb.

how can work?

this have setup

sub removelinks() dim tdf tabledef each tdf in currentdb.tabledefs if left(tdf.name, 4) <> "msys" , (tdf.attributes , dbattachedtable) = dbattachedtable currentdb.tabledefs.delete tdf.name end if next tdf set tdf = nil end sub sub linkdatabase(strdbpath string) dim dbs database dim tdf tabledef set dbs = opendatabase(strdbpath) each tdf in dbs.tabledefs if left(tdf.name, 4) <> "msys" docmd.transferdatabase aclink, "microsoft access", trim(strdbpath), actable, tdf.name, tdf.name syscmd acsyscmdsetstatus, "processing table [" & tdf.name & "]..." end if next tdf syscmd acsyscmdclearstatus set dbs = nil set tdf = nil end sub sub refreshlinks(strdbpath string) dim tdf tabledef each tdf in currentdb.tabledefs if (tdf.attributes , dbattachedtable) = dbattachedtable tdf.connect = "; database = " & strdbpath syscmd acsyscmdsetstatus, "processing table [" & tdf.name & "]..." tdf.refreshlink end if next tdf set tdf = nil syscmd acsyscmdclearstatus end sub

and finally, in error_handler, trap 3044 , phone call

public sub relink(strenginepath) dim dbs database set dbs = currentdb removelinks linkdatabase (strenginepath) refreshlinks (strenginepath) end sub

is there improve way go this?

i have altered code handle text , excel in add-on access tables. if have other types attached, need modify code.

note: code, should not delete links because remove of attributes need!

also, if have parameters next path/file names in connect strings, need add together code retain information. hope have standards in place allow logical actions taken.

sub refreshlinks(strdbpath string) dim ilen integer dim istart integer dim iend integer dim ipos integer dim stroldconn string dim strnewconn string dim strfile string dim tdf tabledef on error goto error_trap each tdf in currentdb.tabledefs if (tdf.attributes , dbattachedtable) = dbattachedtable debug.print "table name: " & tdf.name stroldconn = tdf.connect ' save connect string ilen = len(stroldconn) istart = instr(1, stroldconn, "database=") ' find start of path iend = instr(istart + 1, stroldconn, ";") ' there more after path? debug.print tdf.name & ": " & tdf.connect if lcase(left(stroldconn, 4)) = "text" ' text file attached strnewconn = left(stroldconn, istart + 8) & strdbpath elseif lcase(left(stroldconn, 5)) = "excel" ' excel file attached strfile = "" ipos = ilen 1 step -1 ' file name path if mid(stroldconn, ipos, 1) = "\" exit strfile = mid(stroldconn, ipos, 1) & strfile next if ipos = 0 msgbox "did not find path delimiter '\'" & vbcrlf & vbcrlf & "for tdf '" & tdf.name & "'", vbokonly + vbcritical, "path delimiter unknown" end if strnewconn = left(stroldconn, istart + 8) & strdbpath & "\" & strfile else ' assume access table. if other types, add together code handle. strfile = "" ipos = ilen 1 step -1 ' file name path if mid(stroldconn, ipos, 1) = "\" exit strfile = mid(stroldconn, ipos, 1) & strfile next if ipos = 0 msgbox "did not find path delimiter '\' in connect string '" & stroldconn & "'", vbokonly + vbcritical, "wrong delimiter?" end if strnewconn = left(stroldconn, istart + 8) & strdbpath & "\" & strfile end if debug.print " (new): " & strnewconn tdf.connect = strnewconn syscmd acsyscmdsetstatus, "processing table [" & tdf.name & "]..." tdf.refreshlink else ' ignore table since not linked. end if next tdf set tdf = nil syscmd acsyscmdclearstatus exit sub error_trap: msgbox "error: " & err.number & vbtab & err.description & vbcrlf & vbcrlf & _ "while processing table: " & tdf.name & vbcrlf & _ "old: " & stroldconn & vbcrlf & _ "new: " & strnewconn, vbokonly, "relink error" exit sub end sub

vba access-vba table-definition