Hi Lateral,
Here is code to document Linked tables with:
1. Table Description from source database (if linked table comes from
Access)
2. path and file to linked filename (works with Access and Excel)
put these 2 procedures in a general module. You can assign the function
directly to an event directly using (ie
=DocLinkTables(true, true)
to just run the procedure, run the Sub, RunDocLinkTables
click in the code and press F5
'~~~~~~~~~~~ Document Linked Tables ~~~~~~~~~~~
'--------------- RunDocLinkTables
Sub RunDocLinkTables()
'run this Sub if you don't have an event assigned to DocLinkTables
'to run, click in this code and press F5
DocLinkTables True, True
End Sub
'--------------- DocLinkTables
Function DocLinkTables( _
pBooDesc As Boolean, _
pBooLink As Boolean) As Boolean
'written by crystal
'
[email protected]
'needs reference to
'Microsoft DAO Library
'modifies Description of each table with
'Description from source table if pBooDesc=true
'path of linked database if pBooLink=true
'adds to Description if it already exists
'anything after ~ is replaced
'USEAGE
'assign to an event
' --> =DocLinkTables(true, true)
On Error GoTo Proc_Err
DocLinkTables = False
Dim dbCurrent As dao.Database, dbLink As dao.Database, numLinks As
Integer
Dim tdf As dao.TableDef, mMsg As String, mDesc As String, mProp As
Property
Dim dbLinkName As String, dbLinkNameLast As String, mPos As Integer
CurrentDb.TableDefs.Refresh
DoEvents
Set dbCurrent = CurrentDb
dbLinkName = ""
dbLinkNameLast = ""
numLinks = 0
For Each tdf In dbCurrent.TableDefs
SysCmd acSysCmdSetStatus, "Checking " & tdf.Name & "..."
mMsg = ""
'see if there is a connection string
If Len(tdf.Connect) > 1 Then
mPos = InStr(tdf.Connect, "Database=")
dbLinkName = Mid(tdf.Connect, mPos + 9)
If Left(tdf.Connect, 4) = "Text" Then
dbLinkName = dbLinkName & "\" & tdf.SourceTableName
End If
If pBooLink Then mMsg = dbLinkName
' make sure the file is valid
If Len(Dir(dbLinkName)) = 0 Then
mMsg = "Connection NOT VALID or no code to check --> " _
& mMsg
Else
Select Case True
'~~~ Access ~~~
Case Left(tdf.Connect, 10) = ";DATABASE="
'if this is the same database we just accessed
' use same dbLink
If dbLinkName <> dbLinkNameLast Then
If dbLinkNameLast <> "" Then dbLink.Close
Set dbLink = OpenDatabase(dbLinkName)
dbLinkNameLast = dbLinkName
End If
If pBooDesc Then
On Error Resume Next
mMsg = Nz(dbLink.TableDefs( _
tdf.SourceTableName).Properties("Description") _
, "") & " ~" _
& mMsg
On Error GoTo Proc_Err
End If
'~~~ Excel ~~~
Case Left(tdf.Connect, 5) = "Excel"
mMsg = "Excel > " & mMsg
'~~~ Text ~~~
Case Left(tdf.Connect, 4) = "Text"
mMsg = "Text > " & mMsg
'~~~ Not Access or Excel ~~~
Case Else
MsgBox "No Code written to add more to -->" _
& tdf.Connect, , "Need to Add code"
End Select
End If
If Len(mMsg) = 0 Then mMsg = "Linked table"
If Len(mMsg) > 0 Then
On Error Resume Next
mDesc = Nz(tdf.Properties("Description"), "")
On Error GoTo Proc_Err
If InStr(mDesc, "~") > 0 Then
mDesc = Trim(Left(mDesc, InStr(mDesc, "~") - 1))
End If
mDesc = mDesc & " ~" & mMsg
With tdf
numLinks = numLinks + 1
On Error Resume Next
Set mProp = .CreateProperty("Description", dbText, mDesc)
.Properties.Append mProp
If Err.Number > 0 Then .Properties("Description") = mDesc
On Error GoTo Proc_Err
End With
End If
End If
Next tdf
CurrentDb.TableDefs.Refresh
DoEvents
DocLinkTables = True
MsgBox "Done Documenting Tables: " _
& numLinks & " Linked Table Descriptions changed" _
, , "Done Documenting Tables"
Proc_Exit:
On Error Resume Next
Set mProp = Nothing
Set tdf = Nothing
Set dbCurrent = Nothing
dbLink.Close
Set dbLink = Nothing
SysCmd acSysCmdClearStatus
Exit Function
Proc_Err:
MsgBox Err.Description, , _
"ERROR " & Err.Number & " DocLinkTables" _
& IIf(TypeName(tdf) <> "nothing", ": " & tdf.Name, "")
'press F8 to step through code and debug
'remove next line after debugged
Stop: Resume
Resume Proc_Exit
End Function
'~~~~~~~~~~~~~~~~~~~~
Warm Regards,
Crystal
*
have an awesome day
*
MVP Access
Remote programming and Training
strive4peace2006 at yahoo.com
*
