VBA to Import Updated Forms in Text Files

AlexB123

Board Regular
Joined
Dec 19, 2014
Messages
207
Hi all,

I have an ongoing need to update every form in a database by replacing the production file paths to folders, reports and whatnot with file paths to testing environment folders, reports, etc. I am constantly updating this database, and have been copying my changes from a text editor into every form in a production version of my database. I have been using the text editor's find and replace all function for these strings. My goal is to automate this process, and I have created code that exports all the forms and queries to text files, as well as a PowerShell script that automatically performs the regex replacements I need.

However, my import procedure is not working. Each time it breaks on the .LoadAsText line. I am posting the links I used to create this code. Any help identifying my problem is appreciated.

Note: I also attempted to just write a VBA code within Access that would perform this path replacement for me, but cannot think of an equivalent regex / replace function. I am open to the easiest approach.

Thanks

https://stackoverflow.com/questions...s-recursively-to-text-files/17362688#17362688

https://stackoverflow.com/questions...s-programmatically-from-a-cls-or-similar-file

https://stackoverflow.com/questions...s-programmatically-from-a-cls-or-similar-file

And here is my attempt to import:

Code:
         Option Compare Database
         Option Explicit
  Private Const VB_MODULE               As Integer = 1
  Private Const VB_CLASS                As Integer = 2
  Private Const VB_FORM                 As Integer = 100
  Private Const EXT_TABLE               As String = ".tbl"
  Private Const EXT_QUERY               As String = ".qry"
  Private Const EXT_MODULE              As String = ".bas"
  Private Const EXT_CLASS               As String = ".cls"
  Private Const EXT_FORM                As String = ".frm"
  'Private Const EXT_FORM                As String = ".vb"
  Private Const CODE_FLD                As String = "code"
  Private Const mblnSave                As Boolean = True               ' False: just generate the script
'
'
Public Sub importAllAsText()
            Dim oTable                  As TableDef
            Dim oQuery                  As QueryDef
            Dim oCont                   As Container
            Dim oForm                   As Document
            Dim oModule                 As Object
            Dim FSO                     As Object
            Dim strPath                 As String
            Dim frmPath                As String
    
            Dim strName                 As String
            Dim frmName                As String
            
            Dim strFileName             As String
            Dim frmFileName             As String
            Dim tmpName As String
            
            Dim dlgForms                As FileDialog
            
            Dim I As Integer: I = 0           ' iterator for file name array
            Dim vFileList() As String ' array for file names
            Dim db As DAO.Database
            
            
'**
    'On Error GoTo errHandler
    On Error GoTo 0
    
    Set db = CurrentDb()
    strPath = CurrentProject.Path
    'Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set dlgForms = Application.FileDialog(msoFileDialogFolderPicker)
        With dlgForms
            .Title = "Forms Folder"
            .Show
            frmPath = .SelectedItems(1)
        End With
    
    vFileList = GetFileList(frmPath)
    
  
    Set oCont = db.Containers("Forms")
    For Each oForm In oCont.Documents
        strName = oForm.Name
        'strFileName = strPath & "\" & strName & EXT_FORM
        
        For I = LBound(vFileList) To UBound(vFileList)
            
            If StrComp(strName, Left(vFileList(I), Len(vFileList(I)) - 4), vbTextCompare) = 0 Then
            
            tmpName = Left(vFileList(I), Len(vFileList(I)) - 4)
            frmFileName = frmPath & "\" & vFileList(I)
        
                If mblnSave Then Application.LoadFromText acForm, tmpName, frmFileName
                Debug.Print "Application.LoadFromText acForm, """ & vFileList(I) & """, """ & frmFileName & """"
                'GoTo EndLoop
            End If
            
            I = I + 1
'EndLoop:
        Next
    Next
    'If mblnSave Then MsgBox "Files saved in  " & strPath, vbOKOnly, "Export Complete"
    MsgBox "Complete!!"
    
Exit Sub
errHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf
    Resume Next
End Sub

Function GetFileList(pDirPath As String) As Variant
On Error GoTo GetFileList_err
    ' Local constants / variables
    Const cProcName = "GetFileList"
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim c As Double           ' upper bound for file name array
    Dim I As Double           ' iterator for file name array
    Dim vFileList() As String ' array for file names
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(pDirPath)
    c = objFolder.Files.Count
    I = 0
    ReDim vFileList(1 To c)  ' set bounds on file array now we know count
    'Loop through the Files collection
    For Each objFile In objFolder.Files
        'Debug.Print objFile.Name
        I = I + 1
        vFileList(I) = objFile.Name
    Next
    'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
    GetFileList = vFileList
GetFileList_exit:
    Exit Function
GetFileList_err:
    Debug.Print "Error in ", cProcName, " Err no: ", Err.Number, vbCrLf, "Err Description: ", Err.Description
    Resume Next
End Function

And here is what I've used to export the code to text. I was exporting with the ending ".vb" so my text editor could open up the file with specific formatting. But in this case, I tried both exporting with no file type id as well as ".frm".

Code:
Option Explicit
Option Compare Database
Public Sub SaveToFile()                  'Save the code for all modules to files in currentDatabaseDir\Code
On Error GoTo 0
Dim Name As String
Dim WasOpen As Boolean
Dim Last As Integer
Dim I As Integer
Dim TopDir As String, Path As String, FileName As String
Dim F As Long                          'File for saving code
Dim LineCount As Long                  'Line count of current module
I = InStrRev(CurrentDb.Name, "\")
TopDir = VBA.Left(CurrentDb.Name, I - 1)
    Dim formPath As String
    Dim dlgForms As FileDialog
    Set dlgForms = Application.FileDialog(msoFileDialogFolderPicker)
    With dlgForms
        .Title = "Forms Folder"
        .Show
        formPath = .SelectedItems(1)
    End With
'--- SAVE THE STANDARD MODULES CODE ---
Last = Application.CurrentProject.AllModules.Count - 1
    For I = 0 To Last
        Name = CurrentProject.AllModules(I).Name
        WasOpen = True                       'Assume already open
            If Not CurrentProject.AllModules(I).IsLoaded Then
                WasOpen = False                    'Not currently open
                DoCmd.OpenModule Name              'So open it
            End If
        LineCount = Access.Modules(Name).CountOfLines
        FileName = formPath & "\" & Name & ".vb"
      
            If (Dir(FileName) <> "") Then
                Kill FileName                      'Delete previous version
            End If
        'Save current version
        F = FreeFile
        Open FileName For Output Access Write As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F]#F[/URL] 
        Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F]#F[/URL] , Access.Modules(Name).Lines(1, LineCount)
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F]#F[/URL] 
            If Not WasOpen Then
                DoCmd.Close acModule, Name         'It wasn't open, so close it again
            End If
    Next
'--- SAVE FORMS MODULES CODE ---
Last = Application.CurrentProject.AllForms.Count - 1
    For I = 0 To Last
        Name = CurrentProject.AllForms(I).Name
        WasOpen = True
            If Not CurrentProject.AllForms(I).IsLoaded Then
                WasOpen = False
                DoCmd.OpenForm Name, acDesign
            End If
      LineCount = Access.Forms(Name).Module.CountOfLines
      FileName = formPath & "" & Name & ".vb"
            If (Dir(FileName) <> "") Then
                Kill FileName
            End If
        F = FreeFile
        Open FileName For Output Access Write As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F]#F[/URL] 
        Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F]#F[/URL] , Access.Forms(Name).Module.Lines(1, LineCount)
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=F]#F[/URL] 
            If Not WasOpen Then
                DoCmd.Close acForm, Name
            End If
    Next
'--- SAVE THE QUERIES CODE ---
    Dim queryPath As String
    Dim dlgQry As FileDialog
    Dim db As Database
    Dim Qry As QueryDef
    Dim QryNames As String
    Dim QryText As String
    Dim QryCount As Integer
    
        Set dlgQry = Application.FileDialog(msoFileDialogFolderPicker)
            With dlgQry
                .Title = "Queries Folder"
                .Show
                queryPath = .SelectedItems(1)
            End With
    
    Set db = CurrentDb
        
        QryCount = FreeFile()
        
            For Each Qry In db.QueryDefs
                        
                QryNames = Qry.Name
                QryText = Qry.SQL
                    
                    FileName = queryPath & "" & QryNames & ".sql"
                    Open FileName For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=QryCount]#QryCount[/URL] 
         
                    Debug.Print QryNames, QryText
                    Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=QryCount]#QryCount[/URL] , QryNames, vbNewLine, QryText
                    
                Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=QryCount]#QryCount[/URL] 
            Next
            
    db.Close
    Set db = Nothing
MsgBox "Created source files in " & formPath
MsgBox "Created query files in " & queryPath
End Sub

And here is the powershell code, in case it changes the formatting or encoding of the text files:

Code:
$OldString = 'C:\TEST_DB\EXAMPLE\'
 $NewString = 'C:\TEST_DB\NAME_CHANGE\'
 
 Get-ChildItem C:\DESKTOP\FORMS_PROD\* -recurse |
    Foreach-Object {
        $c = ($_ | Get-Content) 
        $c = $c -replace [RegEx]::Escape($OldString),$NewString
        [IO.File]::WriteAllText($_.FullName, ($c -join "`r`n"))
    }
 
okay good.
Note that I chose to declare the base_directory as a variant because it's easy and convenient to check its status as Empty. That way I don't have to worry about Null strings or empty strings or blank strings :) As you can see from the sample sub, it works whether or not the calling function expects a string or a variant/string. It also tends to work well in Access generally since we have database data types and vba data types and that can be confusing in its own right.
 
Last edited:
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Forum statistics

Threads
1,213,492
Messages
6,113,967
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top