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:
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".
And here is the powershell code, in case it changes the formatting or encoding of the text files:
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 FunctionAnd 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 SubAnd 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"))
}
