Attribute VB_Name = "modReservedWordsChecker"
Option Explicit
'*  A function to check if the name of any table/view/field in a database is a reserved word
'   (for more details, see comments at top of CheckReservedWords)

'*  Requirements:  a reference to "Microsoft ActiveX Data Objects X.X Library"

'*  Author:  Si_the_geek of VBForums.com


'* Example Usage:   (single database)
  'Dim objConn As ADODB.Connection
  'Dim strResult As String
  '                '(open connection)
  '  Set objConn = New ADODB.Connection
  '  objConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
  '                           & "C:\Folder\db.mdb"     'change ConnectionString as apt
  '  objConn.Open
  '
  '              'Check for reserved words
  '  strResult = CheckReservedWords(objConn)
  '  MsgBox strResult
  '
  '              '(close connection)
  '  objConn.Close
  '  Set objConn = Nothing

'* Example output:
  'TABLE names are all valid.
  '[10 checked]
  '
  '** Note - VIEW list could not be loaded, so names not checked! **
  '  (if there are none in your database, this is to be expected!)
  '
  '** FIELD names which are NOT valid: **
  '  money  (in: tblFunds)
  '[131 checked]


'* Example Usage:   (all mdb files in a folder)
  'Dim objConn As ADODB.Connection
  'Dim strFileName As String
  'Dim strResult As String
  'Const strPath As String = "C:\Folder\"
  '
  '  Set objConn = New ADODB.Connection
  '  On Error Resume Next
  '                'find first file
  '  strFileName = Dir(strPath & "*.mdb")
  '  Do While strFileName <> vbNullString
  '                'open connection to this file
  '    objConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
  '                             & "Data Source=" & strPath & strFileName  '
  '    objConn.Open
  '    If Err.Number <> 0 Then
  '      Err.Clear
  '    Else
  '                'Check for reserved words, and close connection
  '      Debug.Print "   ## Results for: " & strFileName & " ##"
  '      strResult = CheckReservedWords(objConn)
  '      objConn.Close
  '      'MsgBox strResult, , strFileName
  '    End If
  '                'find next file
  '    strFileName = Dir()
  '  Loop
  '  Set objConn = Nothing


Function CheckReservedWords(p_Connection_o As ADODB.Connection, _
                            Optional p_CheckAlphaNumeric_b As Boolean = True, _
                            Optional p_IncludePopularRes_b As Boolean = True, _
                            Optional p_NameIndent_s As String = "  ") _
                            As String
'Checks to see if the name of any table/view/field is a reserved word
'(attempts to avoid system tables - only tested in Access & SQL Server)

'Note that the connection must be already open, and should be pointing to a specific database
'The user who is logged in should also have access to all tables/views/fields in the database

'Does not check Synonyms or Temporary tables, only 'real' Tables and Views.

'Parameters:
'  p_Connection_o        - a connection object, as described above.
'  p_CheckAlphaNumeric_b - True to count non-alphanumeric characters as bad
'  p_IncludePopularRes_b - True to include the list of words that are reserved in some "Popular" systems, but not all
'  p_NameIndent_s        - a string containing the amount to indent 'bad' names by.

'Returns:
'  A multi-line string, with a description of the findings for each object type (tables/views/fields).

'Author:
'  Si_the_geek of VBForums.com


Dim vl_Return_s As String, vl_TempReturn_s As String
Dim vl_Rs_o As ADODB.Recordset
Dim vl_AllReserved_s As String
Dim vl_ObjectType_s As String, vl_ObjectTypeCounter_l As Long
Dim vl_ViewFix_b As Boolean
Dim vl_NameField_s As String, vl_ObjectName_s As String
Dim vl_ObjectCount_l As Long, vl_ObjectFailCount_l As Long
Dim vl_CheckIt_b As Boolean, vl_ValidName_b As Boolean
Dim vl_NameParts_s() As String, vl_NamePartCounter_l As Long
Dim vl_CharCounter_l As Long
Dim vl_SysTables_s As String, vl_ValidTables_s As String
Dim vl_Error_s As String

'Reserved words - reserved in one or more popular systems, but not all:
Const cs_ReservedPopular As String = _
          "DATETIME|INDEX|INFORMATION_SCHEMA|JOIN|"
'Reserved words - common to ODBC and OLEDB:
Const cs_ReservedCommon As String = _
          "|ABSOLUTE|ACTION|ADD|ALL|ALLOCATE|ALTER|AND|ANY|ARE|AS|ASC|ASSERTION|AT|" _
        & "AUTHORIZATION|AVG|BEGIN|BETWEEN|BIT|BIT_LENGTH|BOTH|BY|CASCADE|CASCADED|" _
        & "CASE|CAST|CATALOG|CHAR|CHAR_LENGTH|CHARACTER|CHARACTER_LENGTH|CHECK|CLOSE|" _
        & "COALESCE|COLLATE|COLLATION|COLUMN|COMMIT|CONNECT|CONNECTION|CONSTRAINT|" _
        & "CONSTRAINTS|CONTINUE|CONVERT|CORRESPONDING|COUNT|CREATE|CROSS|CURRENT|" _
        & "CURRENT_DATE|CURRENT_TIME|CURRENT_TIMESTAMP|CURRENT_USER|CURSOR|DATE|DAY|" _
        & "DEALLOCATE|DEC|DECIMAL|DECLARE|DEFAULT|DEFERRABLE|DEFERRED|DELETE|DESC|" _
        & "DESCRIBE|DESCRIPTOR|DIAGNOSTICS|DISCONNECT|DISTINCT|DOMAIN|DOUBLE|DROP|" _
        & "ELSE|END|END-EXEC|ESCAPE|EXCEPT|EXCEPTION|EXEC|EXECUTE|EXISTS|EXTERNAL|" _
        & "EXTRACT|FALSE|FETCH|FIRST|FLOAT|FOR|FOREIGN|FOUND|FROM|FULL|GET|GLOBAL|" _
        & "GO|GOTO|GRANT|GROUP|HAVING|HOUR|IDENTITY|IMMEDIATE|IN|INDICATOR|" _
        & "INITIALLY|INNER|INPUT|INSENSITIVE|INSERT|INT|INTEGER|INTERSECT|INTERVAL|" _
        & "INTO|IS|ISOLATION|JOIN|KEY|LANGUAGE|LAST|LEADING|LEFT|LEVEL|LIKE|LOCAL|LOWER|" _
        & "MATCH|MAX|MIN|MINUTE|MODULE|MONTH|NAMES|NATIONAL|NATURAL|NCHAR|NEXT|NO|" _
        & "NOT|NULL|NULLIF|NUMERIC|OCTET_LENGTH|OF|ON|ONLY|OPEN|OPTION|OR|ORDER|" _
        & "OUTER|OUTPUT|OVERLAPS|PARTIAL|POSITION|PRECISION|PREPARE|PRESERVE|PRIMARY|" _
        & "PRIOR|PRIVILEGES|PROCEDURE|PUBLIC|READ|REAL|REFERENCES|RELATIVE|RESTRICT|" _
        & "REVOKE|RIGHT|ROLLBACK|ROWS|SCHEMA|SCROLL|SECOND|SECTION|SELECT|SESSION|" _
        & "SESSION_USER|SET|SIZE|SMALLINT|SOME|SQL|SQLCODE|SQLERROR|SQLSTATE|SUBSTRING|" _
        & "SUM|SYSTEM_USER|TABLE|TEMPORARY|THEN|TIME|TIMESTAMP|TIMEZONE_HOUR|" _
        & "TIMEZONE_MINUTE|TO|TRAILING|TRANSACTION|TRANSLATE|TRANSLATION|TRIM|" _
        & "TRUE|UNION|UNIQUE|UNKNOWN|UPDATE|UPPER|USAGE|USER|USING|VALUE|VALUES|" _
        & "VARCHAR|VARYING|VIEW|WHEN|WHENEVER|WHERE|WITH|WORK|WRITE|YEAR|ZONE|"
'Reserved words - ODBC specific:
Const cs_ReservedODBCOnly As String = _
        "ADA|FORTRAN|INCLUDE|INDEX|NONE|PAD|PASCAL|SPACE|SQLCA|SQLWARNING|"
'Reserved words - OLEDB specific:
Const cs_ReservedOLEDBOnly As String = _
        "DISTINCTROW|TRIGGER|"


  On Error GoTo ErrorHandler:
  vl_Return_s = vbNullString

    'Initialise recordset
  Set vl_Rs_o = New ADODB.Recordset

    'Build the list of reserved words (including all ODBC & OLE DB specific, in case use both for the database)
  vl_AllReserved_s = cs_ReservedCommon & cs_ReservedODBCOnly & cs_ReservedOLEDBOnly
  If p_IncludePopularRes_b Then vl_AllReserved_s = vl_AllReserved_s & cs_ReservedPopular
  Set vl_Rs_o = p_Connection_o.OpenSchema(adSchemaDBInfoKeywords)
  If vl_Rs_o.EOF Then
    vl_Return_s = vl_Return_s _
                & "** Serious issue - could not find the list of provider-specific Reserved Words! **" & vbNewLine _
                & "(the following output will not be conclusive)" _
                & vbNewLine & vbNewLine
  Else
    Do While Not vl_Rs_o.EOF
      vl_AllReserved_s = vl_AllReserved_s & UCase(vl_Rs_o.Fields(0).Value) & "|"
      vl_Rs_o.MoveNext
    Loop
  End If
  vl_Rs_o.Close

    'Find system tables/views, so that we dont report problems with names that are reserved for them!
  vl_SysTables_s = "|"
  vl_ValidTables_s = "|"
  Set vl_Rs_o = p_Connection_o.OpenSchema(adSchemaTables)
  If vl_Rs_o.EOF Then
    vl_Return_s = vl_Return_s _
                & "** Note - system tables/views could not be detected, so ignore any warnings which include them! **" _
                & vbNewLine & vbNewLine
  Else
    With vl_Rs_o
      Do While Not .EOF
        Select Case UCase(.Fields("TABLE_TYPE").Value)
        Case "TABLE", "VIEW"
          Select Case UCase(.Fields("TABLE_SCHEMA").Value)
          Case "INFORMATION_SCHEMA", "SYS"   '(the currently known System schemas)
            vl_SysTables_s = vl_SysTables_s _
                           & UCase(.Fields("TABLE_NAME").Value) & "|"
          End Select
        Case Else   '(TABLE_TYPE values can vary by DBMS, so add any that arent tables/views)
          vl_SysTables_s = vl_SysTables_s _
                         & UCase(.Fields("TABLE_NAME").Value) & "|"
        End Select
        .MoveNext
      Loop
    End With
  End If

    'Check TABLE/VIEW/FIELD names
  For vl_ObjectTypeCounter_l = 1 To 3
    
    vl_TempReturn_s = vbNullString    'Open recordset containing appropriate list
    Select Case vl_ObjectTypeCounter_l
    Case 1:
      vl_ObjectType_s = "TABLE"
      vl_NameField_s = "TABLE_NAME"
      Set vl_Rs_o = p_Connection_o.OpenSchema(adSchemaTables)
    Case 2:
      vl_ObjectType_s = "VIEW"
      vl_NameField_s = "TABLE_NAME"
      On Error Resume Next
      Set vl_Rs_o = p_Connection_o.OpenSchema(adSchemaViews)
      If Err.Number <> 0 Then
        Set vl_Rs_o = p_Connection_o.OpenSchema(adSchemaTables)
        vl_ViewFix_b = True
      End If
      On Error GoTo ErrorHandler:
    Case 3:
      vl_ObjectType_s = "FIELD"
      vl_NameField_s = "COLUMN_NAME"
      Set vl_Rs_o = p_Connection_o.OpenSchema(adSchemaColumns)
    End Select

    If vl_Rs_o.EOF Then               'If could not load, warn (may just be because none exist!)
      vl_Return_s = vl_Return_s _
                  & "** Note - " & vl_ObjectType_s & " list could not be loaded, so names not checked! **" & vbNewLine _
                  & "  (if there are none in your database, this is to be expected!)" _
                  & vbNewLine & vbNewLine

    Else                              'We have data - so see if valid object to check..
      vl_ObjectCount_l = 0
      vl_ObjectFailCount_l = 0
      Do While Not vl_Rs_o.EOF
        If InStr(1, vl_SysTables_s, "|" & UCase(vl_Rs_o.Fields("TABLE_NAME").Value) & "|") > 0 Then
          vl_CheckIt_b = False  '(dont check system tables/views)
        Else
          vl_ObjectName_s = UCase(vl_Rs_o.Fields(vl_NameField_s).Value)
          Select Case vl_ObjectTypeCounter_l
          Case 1    '(table - check if actually a table! [can contain views, etc!])
            vl_CheckIt_b = (UCase(vl_Rs_o.Fields("TABLE_TYPE").Value) = "TABLE")
            If vl_CheckIt_b Then vl_ValidTables_s = vl_ValidTables_s & vl_ObjectName_s & "|"
          Case 2    '(view - if could not retrieve view list, work with table list)
            If vl_ViewFix_b Then
              vl_CheckIt_b = (UCase(vl_Rs_o.Fields("TABLE_TYPE").Value) = "VIEW")
            Else
              vl_CheckIt_b = True
            End If
            If vl_CheckIt_b Then vl_ValidTables_s = vl_ValidTables_s & vl_ObjectName_s & "|"
          Case 3    '(field - only check if it is in a table we checked)
            vl_CheckIt_b = (InStr(1, vl_ValidTables_s, "|" & UCase(vl_Rs_o.Fields("TABLE_NAME").Value) & "|") > 0)
          End Select
        End If
        If vl_CheckIt_b Then              '..it is a valid object, so check the name

          vl_ObjectCount_l = vl_ObjectCount_l + 1
          vl_ValidName_b = True
                                                '(check whole name)
          If InStr(1, vl_AllReserved_s, "|" & vl_ObjectName_s & "|") > 0 Then
            vl_ValidName_b = False
                                                '(check parts of the name, if have spaces)
          ElseIf InStr(1, vl_ObjectName_s, " ") > 0 Then
            If p_CheckAlphaNumeric_b Then
              vl_ValidName_b = False
            Else
              vl_NameParts_s = Split(vl_ObjectName_s, " ")
              For vl_NamePartCounter_l = LBound(vl_NameParts_s) To UBound(vl_NameParts_s)
                If InStr(1, vl_AllReserved_s, "|" & vl_NameParts_s(vl_NamePartCounter_l) & "|") > 0 Then
                  vl_ValidName_b = False
                  Exit For
                End If
              Next vl_NamePartCounter_l
              Erase vl_NameParts_s
            End If
                                                '(check for non-alpha, if apt)
          ElseIf p_CheckAlphaNumeric_b Then
            For vl_CharCounter_l = 1 To Len(vl_ObjectName_s)
              Select Case Mid$(vl_ObjectName_s, vl_CharCounter_l, 1)
              Case "A" To "Z", "0" To "9", "_"
              Case Else
                vl_ValidName_b = False
                Exit For
              End Select
            Next vl_CharCounter_l
          End If

          If Not (vl_ValidName_b) Then    'If this name is not valid, add it to the list
            vl_ObjectFailCount_l = vl_ObjectFailCount_l + 1
            Select Case vl_ObjectTypeCounter_l
            Case 1, 2  '(table,view)
              vl_TempReturn_s = vl_TempReturn_s _
                              & p_NameIndent_s & vl_Rs_o.Fields(vl_NameField_s).Value & vbNewLine
            Case 3     '(field)
              vl_TempReturn_s = vl_TempReturn_s _
                              & p_NameIndent_s & vl_Rs_o.Fields("COLUMN_NAME").Value _
                                               & "  (in: " & vl_Rs_o.Fields("TABLE_NAME").Value & ")" & vbNewLine
            End Select
          End If

        End If
        vl_Rs_o.MoveNext
      Loop
                                      'Add results for this object type to the return message
      If vl_TempReturn_s <> vbNullString Then
        vl_Return_s = vl_Return_s _
                    & "** " & vl_ObjectType_s & " names which are NOT valid: **" & vbNewLine _
                    & vl_TempReturn_s _
                    & "[" & vl_ObjectFailCount_l & " of " & vl_ObjectCount_l & " checked]" _
                    & vbNewLine & vbNewLine
      Else
        vl_Return_s = vl_Return_s _
                    & vl_ObjectType_s & " names are all valid." & vbNewLine _
                    & "[" & vl_ObjectCount_l & " checked]" _
                    & vbNewLine & vbNewLine
      End If
                  
    End If
    vl_Rs_o.Close
  Next vl_ObjectTypeCounter_l

    'Set Return value, and put in immediate window
  CheckReservedWords = vl_Return_s
  Debug.Print vl_Return_s

    'Error handling (which is only run if an error has occured!)
ErrorHandler:
  If Err.Number <> 0 Then
    vl_Error_s = "ERROR OCCURED!" & vbNewLine _
               & "Error " & Err.Number & ": " & Err.Description & vbNewLine & vbNewLine
    If vl_ObjectType_s <> vbNullString Then
      vl_Error_s = vl_Error_s _
                 & "While checking " & vl_ObjectType_s
    End If
    If Not vl_Rs_o Is Nothing Then    '(if the recordset is open, close it)
      If (vl_Rs_o.State And adStateOpen) = adStateOpen Then vl_Rs_o.Close
    End If
    Debug.Print vl_Error_s
    vl_Error_s = vl_Error_s & vbNewLine & vbNewLine _
               & "You should exit this program properly, to ensure that the connection is closed safely."
    MsgBox vl_Error_s, vbCritical, "Error (copied to Immediate window)"
  End If

    'Tidy up
  Set vl_Rs_o = Nothing
  vl_AllReserved_s = vbNullString
  vl_ValidTables_s = vbNullString
  vl_SysTables_s = vbNullString
  vl_TempReturn_s = vbNullString
  vl_Return_s = vbNullString

End Function