NEW - May 16/2004   A2KAddSQLComments.zip is an MDB containing functions to:

1) To allow the saving of Comments in the SQL View window.
2) To allow the saving/restoration of Comments in the SQL View window.

Here is the A97 version:A97AddSQLComments.zip

History

Version 1.3 May 16, 2004

As per a suggestion from Dimitri Furman, modified parsing function to allow for multiple instances of the Access SQL string delimiter character(";")

Version 1.1 May 16, 2004

First release!

Here is the source code:

Option Compare Database
Option Explicit

'DEVELOPED AND TESTED UNDER MICROSOFT ACCESS 97, 2K, and 2K2 VBA
'
'Copyright: Stephen Lebans - Lebans Holdings 1999 Inc.
' Please feel free to use this code within your own projects,
' both private and commercial, with no obligation.
' You may not resell this code by itself or as part of a collection.
'
'
'Name: Add/Save/Modify Comments for the SQL View window
'
'Version: 1.1
'
'Purpose: 1) To allow the saving of Comments in the SQL View window.
' 2) To allow the saving/restoration of Comments in the SQL View window.
' 
'Requires: The table named "SQL-Comments" included with this sample MDB
'
'Author: Stephen Lebans
'
'Email: Stephen@lebans.com
'
'Web Site: www.lebans.com
'
'Date: May 16, 2004, 11:11:11 AM
'
'Credits: Yours for the taking!<grin.
'
'BUGS: Please report any bugs to:
' Stephen@lebans.com
'
'What's Missing:
' DAO error handling
' All other Error handling
' Add it yourself!
'
'How it Works:
' Walk through the source code!<grin>
'
' Enjoy
' Stephen Lebans

Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function apiGetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) _
As Long

Private Declare Function GetFocus Lib "user32" () As Long

Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function IsWindowVisible Lib "user32" _
(ByVal hWnd As Long) As Long




Public Function fShowComments()
On Error GoTo Err_ShowComments

' This function can only be called from a
' ToolBar/Menu when the SQL Design window
' is in SQL view.

Dim varLength As Variant
Dim lngRet As Long
Dim hWndMDI As Long
Dim hWndOQry As Long
Dim hWndOKttbx As Long
Dim hwndODsk As Long
Dim hWndOSUI As Long
Dim s As String
Dim sComment As String
Dim sCaption As String
sComment = "/Comments Start Here: Remember to HIDE the comments before Saving this Query!!!!!" & vbCrLf
' Recordset stuff
Dim rst As DAO.Recordset
Dim sSQL As String
Dim sSel As String
Dim db As DAO.Database

hWndOKttbx = GetFocus
If fGetClassName(hWndOKttbx) <> "OKttbx" Then
fShowComments = False
Exit Function
End If

' Get Parent
hWndOQry = GetParent(hWndOKttbx)
' If not "OQry" then we are not in Query Design window
If hWndOQry = 0 Then Exit Function

If fGetClassName(hWndOQry) <> "OQry" Then
fShowComments = False
Exit Function
End If

' Get the Caption of the SQL Design window
sCaption = Space(512)
lngRet = GetWindowText(hWndOQry, sCaption, 256)
sCaption = Left(sCaption, lngRet)
If Len(sCaption & vbNullString) = 0 Then Exit Function

' Find the window of class ODsk
hwndODsk = FindWindowEx(hWndOQry, 0&, "ODsk", vbNullString)
' If does nto exist then we are not in the Query Design window
If hwndODsk = 0 Then Exit Function
' If this Window is Visible then we are not in the
' SQL View window!
lngRet = IsWindowVisible(hwndODsk)
If lngRet <> 0 Then Exit Function

' Get the Text of the SQL Design window
s = Space(4096)
lngRet = GetWindowText(hWndOKttbx, s, 2048)
s = Left(s, lngRet)
If Len(s & vbNullString) = 0 Then Exit Function


' See if there are already Comments in place.
' If so REMOVE THEM
varLength = InStr(1, s, "/Comment", vbTextCompare)
If varLength <> 0 Then
' Remove comments
' Save Comments to Disk first!!

' Grab a ref to the CurrentDB
Set db = CurrentDb()
' Setup our SQL string
sSQL = "SELECT [SQL-Comments].QueryName, [SQL-Comments].Comment FROM [SQL-Comments] WHERE [SQL-Comments].QueryName = " & """" & sCaption & """"
Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

' Empty?
If rst.RecordCount = 0 Then
' No existing record. Create one.
rst.AddNew
Else
rst.Edit
End If
rst.Fields("QueryName") = sCaption
rst.Fields("Comment") = Mid(s, varLength)
rst.Update

' Free our RecordSet
Set rst = Nothing
db.Close
Set db = Nothing

' Remove our Comment from the SQL View window
' Remove everything after the SQL EOF marker ";"
s = Left(s, InStr(1, s, ";", vbTextCompare))
lngRet = SetWindowText(hWndOKttbx, s)
Exit Function
End If

' If we arrive here then no comments are displayed.
' Let's check our table and see if there is an existing
' entry for this saved Query. If so then display it!
' Grab a ref to the CurrentDB
Set db = CurrentDb()
' Setup our SQL string
sSQL = "SELECT [SQL-Comments].QueryName, [SQL-Comments].Comment FROM [SQL-Comments] WHERE [SQL-Comments].QueryName = " & """" & sCaption & """"
Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

' Empty?
If rst.RecordCount = 0 Then
' Add our New Comment Header
s = s & vbCrLf & vbCrLf & sComment
lngRet = SetWindowText(hWndOKttbx, s)
Else
' Load and display our stored comment
s = s & vbCrLf & vbCrLf & rst.Fields("Comment")
lngRet = SetWindowText(hWndOKttbx, s)
End If

' Free our RecordSet
Set rst = Nothing
db.Close
Set db = Nothing

'DoCmd.Beep
Exit_Err_ShowComments:
Exit Function

Err_ShowComments:
MsgBox Err.Description
Resume Exit_Err_ShowComments

End Function


' From Dev Ashish's Site
' The Access Web
' http://www.mvps.org/access/

'******* Code Start *********
Private Function fGetClassName(hWnd As Long)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
strBuffer = Space$(MAX_LEN)
lngLen = apiGetClassName(hWnd, strBuffer, MAX_LEN)
If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function
'******* Code End *********