Solved: Read query description property

[Marcster]

Hello people :hi: ,

Is it possible to read the contents of a query's description (displayed in it's properties) via VBA or another query?.

The reason I ask is, I have a query which lists all the queries in the database but am unable to display any useful info about the query except the name, date created and date last modified.

So if I place some info in the query description property, I would like to be able to display that too.

Is this possible?. :dunno

Thanks.

[xCav8r]

:hi:


If it can be done, I'd like to know how. AFAIK, description is not a property of AccessObject, and I don't know how else to get it. :dunno

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaac11/html/accolAllQueries_HV05251615.asp

[geekgirlau]

Function GetDescription(strQuery As String)
Dim db As DAO.Database
Dim qdf As DAO.QueryDef

Set db = CurrentDb
Set qdf = db.QueryDefs(strQuery)
GetDescription = qdf.Properties("Description")

qdf.Close
db.Close
Set db = Nothing
End Function

[xCav8r]

Cool, geekgirl. You rock. :bow:

http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/office97/html/output/F1/D2/S5A2E0.asp

[Marcster]

Thank you. :thumb
That was just what I was after.

Just a thought, is it possible to do the same for other objects like Tables, Forms and Reports?. :dunno

[geekgirlau]

Sub DocumentAll()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Purpose: Writes object type, name and description of all database
' tables, queries, forms and reports to a text file
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim db As DAO.Database ' database
Dim tdf As DAO.TableDef ' all tables
Dim qdf As DAO.QueryDef ' all queries
Dim doc As DAO.Document ' all forms/reports
Dim prp As Property 'object property
Dim strPath As String ' path for text file
Dim bytType As Byte ' type of object


On Error GoTo ErrHandler
strPath = "C:\Data\DatabaseObjects.txt"

If Dir(strPath, vbNormal) <> "" Then
Kill strPath
End If

Open strPath For Append As #1

' print headings for text file
Print #1, "Object Type" & vbTab & "Object Name" & vbTab & "Description"

Set db = CurrentDb

' tables
bytType = 1
For Each tdf In db.TableDefs
' exclude system tables
If LCase(Left(tdf.Name, 4)) <> "msys" Then
Print #1, "Table" & vbTab & tdf.Name & vbTab & _
tdf.Properties("Description")
End If
Next tdf

' queries
bytType = 2
For Each qdf In db.QueryDefs
' exclude system queries
If LCase(Left(qdf.Name, 1)) <> "~" Then
Print #1, "Query" & vbTab & qdf.Name & vbTab & _
qdf.Properties("Description")
End If
Next qdf

' forms
bytType = 3
With db.Containers!Forms
For Each doc In .Documents
Print #1, "Form" & vbTab & doc.Name & vbTab & _
doc.Properties("Description")
Next doc
End With

' reports
bytType = 4
With db.Containers!Reports
For Each doc In .Documents
Print #1, "Report" & vbTab & doc.Name & vbTab & _
doc.Properties("Description")
Next doc
End With

ExitHere:
On Error Resume Next
qdf.Close
db.Close

Set tdf = Nothing
Set qdf = Nothing
Set doc = Nothing
Set prp = Nothing
Set db = Nothing
Close #1
Exit Sub

ErrHandler:
If Err.Number = 3270 Then
' property not found - need to create
Select Case bytType
Case 1 ' table
Set prp = tdf.CreateProperty("Description", dbText)
prp.Value = "No Description Set"
tdf.Properties.Append prp

Case 2 ' query
Set prp = qdf.CreateProperty("Description", dbText)
prp.Value = "No Description Set"
qdf.Properties.Append prp

Case 3, 4 ' form/report
Set prp = doc.CreateProperty("Description", dbText)
prp.Value = "No Description Set"
doc.Properties.Append prp
End Select

Err.Clear
Resume

Else
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End If
End Sub



Haven't played around with macros and modules yet, but you get the gist!

[xCav8r]

If this isn't already in the KB, it would make a nice addition. ;)

[Marcster]

Totally agree with you xCav8r, it would make a great KB entry :yes .

Over to you geekgirlau.

How about instead of exporting to a text file, the data gets written to a new table, how do I do this ?

I don't ask for much do I? :winking2: .

[geekgirlau]

Okay - you win! Code below, and KB entry submitted for approval :thumb


Sub DocumentAll()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Purpose: Writes object type, name and description of all database
' tables, queries, forms and reports to a text file
'
' Assumptions: Existence of table "tbl_Documenter"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim db As DAO.Database ' database
Dim tdf As DAO.TableDef ' all tables
Dim qdf As DAO.QueryDef ' all queries
Dim doc As DAO.Document ' all forms/reports
Dim rec As DAO.Recordset ' table to write descriptions
Dim prp As Property ' object property
Dim strSQL As String ' clear existing documenter table
Dim bytType As Byte ' type of object


On Error Goto ErrHandler


' clear existing documented structure
strSQL = "DELETE * " & _
"FROM tbl_Documenter"

DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True

' capture all database objects
Set db = CurrentDb
Set rec = db.OpenRecordset("tbl_Documenter", dbOpenDynaset)

' tables
bytType = 1
For Each tdf In db.TableDefs
' exclude system tables
If LCase(Left(tdf.Name, 4)) <> "msys" And _
tdf.Name <> "tbl_Documenter" Then
With rec
.AddNew
!txt_Doc_ObjectType = "Table"
!txt_Doc_Name = tdf.Name
!txt_Doc_Description = tdf.Properties("Description")
.Update
End With
End If
Next tdf

' queries
bytType = 2
For Each qdf In db.QueryDefs
' exclude system queries
If LCase(Left(qdf.Name, 1)) <> "~" Then
With rec
.AddNew
!txt_Doc_ObjectType = "Query"
!txt_Doc_Name = qdf.Name
!txt_Doc_Description = qdf.Properties("Description")
.Update
End With
End If
Next qdf

' forms
bytType = 3
With db.Containers!Forms
For Each doc In .Documents
With rec
.AddNew
!txt_Doc_ObjectType = "Form"
!txt_Doc_Name = doc.Name
!txt_Doc_Description = doc.Properties("Description")
.Update
End With
Next doc
End With

' reports
bytType = 4
With db.Containers!Reports
For Each doc In .Documents
With rec
.AddNew
!txt_Doc_ObjectType = "Report"
!txt_Doc_Name = doc.Name
!txt_Doc_Description = doc.Properties("Description")
.Update
End With
Next doc
End With


ExitHere:
On Error Resume Next
qdf.Close
rec.Close
db.Close

Set tdf = Nothing
Set qdf = Nothing
Set doc = Nothing
Set prp = Nothing
Set rec = Nothing
Set db = Nothing
Close #1
Exit Sub

ErrHandler:
If Err.Number = 3270 Then
' property not found - need to create
Select Case bytType
Case 1 ' table
Set prp = tdf.CreateProperty("Description", dbText)
prp.Value = "No Description Set"
tdf.Properties.Append prp

Case 2 ' query
Set prp = qdf.CreateProperty("Description", dbText)
prp.Value = "No Description Set"
qdf.Properties.Append prp

Case 3, 4 ' form/report
Set prp = doc.CreateProperty("Description", dbText)
prp.Value = "No Description Set"
doc.Properties.Append prp
End Select

Err.Clear
Resume

Else
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End If
End Sub

[geekgirlau]

Marcster, I didn't state it explicitly above, but you'll need to create a table called "tbl_Documenter" with the following fields:

txt_Doc_ObjectType (text field, 15 characters)
txt_Doc_Name (text field, 50 characters)
txt_Doc_Description (text field, 255 characters or memo field if you're likely to have really long descriptions!)

[Marcster]

Hi geekgirlau,
Thanks alot for that :clap2: , much appreciated :yes .
Works great:yay.

Marcster.

[geekgirlau]

My pleasure - don't forget to mark the post as "Solved"