Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

MS Access and CVS Version Control

Status
Not open for further replies.

123FakeSt

IS-IT--Management
Aug 4, 2003
182
I was given the mission of completely integrating CVS Version Control (like SourceSafe) with our MS Access Database App (2K version).

The solution I came up with was to run this code after making any changes to the application.

Is there anything I'm missing ... is there an easier way?

Code:
Option Compare Database
Option Explicit

Sub UpdateVersionControl(Optional strDatabaseFullPath As String = "", Optional strCVSFullPath As String = "")
'Loops through all tables and records field names and types, then all other objects and records code etc.
'R Baker 2006 02 22
'v 1.1

If strDatabaseFullPath = "" Then strDatabaseFullPath = Application.CurrentDb.Name
If strCVSFullPath = "" Then strCVSFullPath = "C:\CSD"

'Write tables
WriteTableStructures "C:\Documents and Settings\rbaker5\Database\Services Database v5.1.mdb", "C:\CSD"

'Write all other objects
WriteObjects "C:\Documents and Settings\rbaker5\Database\Services Database v5.1.mdb", "C:\CSD"

End Sub

Public Function WriteTableStructures(strDatabaseMaster As String, strPath As String)
'Writes Contents of Each Table to log file
'Designed for use with version control
'R Baker 2006 02 22

Dim strSQL As String
Dim rst1 As ADODB.Recordset
Set rst1 = New ADODB.Recordset
Dim objFSO As Object
Dim objLogFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim db1 As DAO.Database
Dim fld1 As DAO.Field

Set db1 = DBEngine.Workspaces(0).OpenDatabase(strDatabaseMaster, True)

'Loop through all tables in the Master Database, for each table
strSQL = "SELECT * FROM msysobjects IN """ & strDatabaseMaster & """" & " WHERE type IN (1,6) AND name NOT LIKE ""MSys*"""
rst1.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly
If Not rst1.EOF Then
    rst1.MoveFirst
    Do Until rst1.EOF
        If Left(rst1!Name, 4) <> "MSys" Then
        
            'Create a File for the table
            Set objLogFile = objFSO.CreateTextFile(strPath & "\" & rst1!Name & ".txt", True)
            
            'Loop through all of the fields in the Master Table
            For Each fld1 In db1.TableDefs(rst1!Name).Fields
            
                'Write a line for the field
                objLogFile.WriteLine rst1!Name & "." & fld1.Name & "|" & fld1.Type & Chr(13)
            Next
        End If
        rst1.MoveNext
    Loop
End If
rst1.Close

objLogFile.Close
Set objLogFile = Nothing
Set objFSO = Nothing
Set rst1 = Nothing
Set fld1 = Nothing
Set db1 = Nothing

End Function

Public Function WriteObjects(strDatabaseMaster As String, strPath As String)
'Writes Structure of Each Object Type to log file
'Designed for use with version control
'R Baker 2006 02 22

Dim strSQL As String
Dim intObjectType As Integer

Dim rst1 As New ADODB.Recordset

'Loop through all tables in the Master Database, for each table
strSQL = "SELECT * FROM msysobjects IN """ & strDatabaseMaster & """" & " WHERE type IN (" & _
    "5,-32768,-32764,-32766,-32761" & _
    ") AND name NOT LIKE ""MSys*"""
rst1.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly
If Not rst1.EOF Then
    rst1.MoveFirst
    Do Until rst1.EOF
        If Left(rst1!Name, 4) <> "MSys" Then
            Select Case rst1!Type
                Case 5:         intObjectType = 1
                Case -32768:    intObjectType = 2
                Case -32764:    intObjectType = 3
                Case -32766:    intObjectType = 4
                Case -32761:    intObjectType = 5
            End Select
            
            'Create a File for the table
            If Left(rst1!Name, 1) <> "~" Then
                    SaveAsText intObjectType, rst1!Name, strPath & "\" & rst1!Name & ".txt"
            End If
        End If
        rst1.MoveNext
    Loop
End If

Set rst1 = Nothing

End Function

Sub RunVersionControlUpdate()
UpdateVersionControl
End Sub

The early bird gets the worm, but the second mouse gets the cheese.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top