Extract db code to text files...

Hi Jillyn_D,

If the number of modules is manageable, why not just export the modules from the VB Editor?

For example, a regular module exports with a BAS extension, but it's just text.

Regards,

Patrick

Hi, Patrick :)

Thanks for the response!

I have over 70 databases in a directory that I want to loop through and create text files for, and I know how to do all but the extraction of the code for the modules and forms.  Each database only has a few modules, but they often have many forms, and manual extraction of the information would be very time consuming...

~Jillyn

You will need a reference for Microsoft VBA 5.x Extensibility.

The VBA _name is derived from going through msysobjects, where type is form, report or module.  Since VBComponent.Name for form is FORM_ and form name, then VBA_Name is "Form_" & msysobjects.NAME
Same goes for reports, with prefix of "Report_"
Modules have no prefix.

Steve/Jerry,

Exactly what I was looking for!  Thank you very much!

~Jillyn

hmmm ... code behind forms ... you can use the save as text for a form object also but then you get all the form/control properties also ... let me play a bit...

Steve

Steve,

Thanks very much, but honestly this is great.  I just needed a push in the right direction :)

Thanks again for the help!

~Jillyn

At the risk of posting a long string of code, I built this not more than two weeks ago for exactly what you want.
But with the central process of identifying forms, reports and modules, reformatting their names to their VBComponent names, i tuink you can work it out.
Let me know.

Jerry,

I'd be curious to see it :)

Regards,

Patrick

Patrick:'OK, GI, 5 dollah!'  You asked for it.

If you have questions, please feel free to ask.

A folder tree is selected.
Programs goes into every database
Program imports every form, report and module (one at a time)
Program extracts any code from that object and writes it to a text file in a
folder called D:|moduletext1
Program writes source database name, object text, created text file name,
text file size and CRC of text file contents to a table in original db.  The facilitates getting rid of redundant files,


Function getmodules() 'opens databases for pulling in modules, forms and reports
'we will end up with a database path and filename, which is passed as .foundfiles(i) to eith getmod or getform functions
Call CHECK_TABLE 'ensures modtext table exists in database.  If not, creates it.
Call check_dir 'ensures directory for storing text files exists.  If not, creates it.
Dim xx As String
xx = MsgBox("This will extract all code from folder tree which you select.   Select CANCEL to exit.", vbOKCancel)
If xx = vbCancel Then
Exit Function
End If
DoCmd.SetWarnings False

Dim fs, i, temp As Variant
Dim DBS As Database
Dim RST As Recordset
Dim Err_rst As Recordset
Dim SQL As Variant
Dim Strsql As String


Set DBS = CurrentDb
Set fs = Application.FileSearch

SQL = BrowseFolder("Enter Start Point") & "\"  'go to http://www.mvps.org/access/api/api0002.htm for browsefolder function

On Error Resume Next
On Error GoTo 0

With Application.FileSearch
    .NewSearch
    .LookIn = SQL
    .SearchSubFolders = True
    .FileName = "*.mdb"
    If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            'MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
        For i = 1 To .FoundFiles.Count
        Call getforms(.FoundFiles(i)) 'used to import forms and reports
  '      Call getmod(.FoundFiles(i)) 'used to import modules
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With

DBS.Close
DoCmd.SetWarnings True
MsgBox "Processing Complete!"
End Function

Function getforms(FileName As String) 'receive path and filename of db.
On Error Resume Next
'import forms and reports from db
'create class name, based on whether form or report (or later, module)
'pass class name to getmodtext function
Dim Strsql As String
Dim rs As Recordset
Dim newformname As String
Dim vba_name As String
Dim import_type As String
Dim vb_type As String
Strsql = "select name, (parentid mod 3) as typenum from msysobjects in '" & FileName & "' where parentid between -2147483647 and -2147483645"
Set rs = CurrentDb.OpenRecordset(Strsql)
If rs.RecordCount = 0 Then
Exit Function
End If
rs.MoveFirst
Do While Not rs.EOF
If DCount("name", "msysobjects", "name = '" & rs!NAME & "'") > 0 Then
newformname = rs!NAME & "A"
Else
newformname = rs!NAME
End If
Select Case rs!typenum
    Case -1
    import_type = acForm
    vb_type = "Form_"
    Case -2
    import_type = acReport
    vb_type = "Report_"
    Case 0
    import_type = acModule
    vb_type = ""
    End Select
DoCmd.TransferDatabase acImport, "Microsoft Access", FileName, import_type, rs!NAME, newformname
vba_name = vb_type & newformname
Call getmodtext(vba_name, FileName)
DoCmd.DeleteObject import_type, newformname

rs.MoveNext
Loop
rs.Close
End Function

Function getmodtext(vba_name As String, FileName As String)
Dim modComp As VBComponent
Dim newname As String
'change this constant to your desired output folder path
Const EXPORT_FILEPATH As String = "d:\moduleText1\"

    For Each modComp In Application.VBE.VBProjects(1).VBComponents
        If modComp.NAME = vba_name Then
        Debug.Print modComp.CodeModule.CountOfLines
               
 '       MsgBox "wait"
        newname = EXPORT_FILEPATH & modComp.NAME & ".txt"
       
        If Dir(newname) <> "" Then
   newname = EXPORT_FILEPATH & modComp.NAME & "_" & getrand(Now()) & ".txt"
     End If
     
  modComp.Export Replace(newname, "/", "") 'ensures no '/' in form/report/module name
        End If
    Next modComp
Call doTextImport(FileName, vba_name, newname) 'this will database your item details for simpler retrieval
End Function

Function CHECK_TABLE()
If DCount("*", "MSYSOBJECTS", "NAME = 'MODTEXT'") < 1 Then
DoCmd.RunSQL ("CREATE TABLE MODTEXT(DB TEXT(255), CLASSNAME TEXT(50), CLASS long, filename text(50), CRC long)")
'MsgBox "DONE!"
End If
End Function
Function doTextImport(FileName As String, vba_name As String, newname As String)
Dim strsql5 As String
Dim strmemo As String
Dim strmemolen As String
  Dim f As Integer
   f = FreeFile                   'Get a file handle
   Open newname For Input As f   'Open the file
  strmemo = Input$(LOF(f), f) 'Read entire file into text box
   Close f
   strmemolen = Len(strmemo)
   strsql5 = "insert into modtext(db, classname, class, filename, crc) VALUES('" & FileName & "','" & vba_name & "'," & strmemolen & ",'" & newname & "'," & 

CalcCRC32(strmemo) & ")"
   DoCmd.RunSQL (strsql5)
'Debug.Print strmemo
'MsgBox FileName & "/" & vba_name & "/" & newname
End Function
Public Function CalcCRC32(str As String) As Long
Dim i As Long
Dim j As Long
Dim Limit As Long
Dim CRC As Long
Dim Temp1 As Long
Dim Temp2 As Long
Dim CRCTable(0 To 255) As Long
 
  Limit = &HEDB88320
  For i = 0 To 255
    CRC = i
    For j = 8 To 1 Step -1
      If CRC < 0 Then
        Temp1 = CRC And &H7FFFFFFF
        Temp1 = Temp1 \ 2
        Temp1 = Temp1 Or &H40000000
      Else
        Temp1 = CRC \ 2
      End If
      If CRC And 1 Then
        CRC = Temp1 Xor Limit
      Else
        CRC = Temp1
      End If
    Next j
    CRCTable(i) = CRC
  Next i
  Limit = Len(str) 'UBound(ByteArray)
  CRC = -1
  For i = 1 To Limit
    If CRC < 0 Then
      Temp1 = CRC And &H7FFFFFFF
      Temp1 = Temp1 \ 256
      Temp1 = (Temp1 Or &H800000) And &HFFFFFF
    Else
      Temp1 = (CRC \ 256) And &HFFFFFF
    End If
    Temp2 = Asc(Mid(str, i, 1)) ' ByteArray(I)   ' get the byte
    Temp2 = CRCTable((CRC Xor Temp2) And &HFF)
    CRC = Temp1 Xor Temp2
  Next i
  CRC = CRC Xor &HFFFFFFFF
  CalcCRC32 = CRC
End Function

Function check_dir()
If Dir("d:\moduleText1\", vbDirectory) = "" Then
MkDir "D:\moduletext1\"
End If
End Function

Thanks, Jerry!  You're right, this does almost exactly what I want!

I've never see anything posted like this before...good method!
    > SQL = BrowseFolder("Enter Start Point") & "\"  'go to
    > http://www.mvps.org/access/api/api0002.htm for browsefolder function

~Jillyn

Just about everything in here I got from browsing through EE> (CRC function pointed out by colleague.) After I posted question 26 Dec, I spent a lot of time fine-tuning this for my requirements.

*grins* I know how that goes.  I'm amazed by how much I've learned in the short time I've been here.  Although I have some background in programming and database theory, prior to joining EE I had learned all my Access stuff from the MS help files!