Option Compare Database
Option Explicit
Function GlobalReplaceText() 'This function executes the code.
Call ReplaceStringGlobal("Find_What", "Replace_With_What")
End Function
Function ReplaceStringGlobal(sFind As String, sReplace As String)
On Error Resume Next
If InStr(1, sReplace, sFind) Then
MsgBox "You must choose something more unique For " & sReplace & " because you can Not include the word/phrase: '" & sFind & "' in your replacement text."
Exit Function
End If
Dim tmpHold As String
Dim i As Integer
Dim Frm
Dim oForm
Dim Cnt
Dim db As Database
Set db = CurrentDb()
Dim FN As Integer
FN = FreeFile
Dim oFile As String
oFile = db.Name + " " + Format(Now(), "MMDDYY") & "-" & sFind & " " & sReplace & ".rtf"
Open oFile For Output As #FN
Print #FN, "{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\froman\fcharset2 Symbol;}{\f2\froman Times New Roman;}{\f3\fmodern Courier New;}{\f4\froman\fprq2 Times New Roman;}{\f5\fmodern\fprq1 Courier New;}}"
Print #FN, "{\colortbl\red0\green0\blue0;\red128\green128\blue0;\red0\green0\blue128;}"
FORMS:
Print #FN, "\par \pard\plain\f4\fs28\cf0\b " & "FORMS Search/Replace Replacing """ & sFind & """" & " with: """ & sReplace & """" & "\plain\f2\fs16 "
For Each Frm In db.Containers("Forms").Documents
DoCmd.Close acForm, oForm.Parent.Name, acSaveYes
DoCmd.OpenForm Frm.Name, acDesign, , , , acHidden
oForm = Access.FORMS(Frm.Name)
Print #FN, "\par \pard \nowidctlpar\adjustright\plain\f3\fs20\cf3\cgrid0\b " & Access.FORMS(Frm.Name).Name & ":\plain\f1\fs24\cf1\b"
If InStr(1, Access.FORMS(Frm.Name).RecordSource, sFind) Then
Print #FN, "\par \pard\plain\f5\fs20\cf5\b\i MATCHED IN: " & Access.FORMS(Frm.Name).Name & " Recordsource:\plain\f2\fs16\b"
tmpHold = Access.FORMS(Frm.Name).RecordSource
Do Until InStr(1, tmpHold, sFind) <= 0
If Len(tmpHold) <= Len(sFind) Then
tmpHold = sReplace
Exit Do
End If
tmpHold = Left(tmpHold, InStr(1, tmpHold, sFind) - 1) & "\plain\f4\fs20\cf1\ul " & sReplace & "\plain\f4\fs20 " & Right(tmpHold, Len(tmpHold) - (InStr(tmpHold, sFind) - 1) - Len(sFind))
Loop
Print #FN, "\par \pard\li720\plain\f3\fs20 " & tmpHold
Access.FORMS(Frm.Name).RecordSource = StripSymbol(Access.FORMS(Frm.Name).RecordSource, sFind, sReplace)
Else
Print #FN, "\par \pard\plain\f5\fs20\cf5\b\i No Match in " & oForm.Name & " Recordsource. \plain\f2\fs16\b"
End If
For Each Cnt In oForm
tmpHold = ""
Select Case Cnt.ControlType
Case acComboBox
tmpHold = Cnt.Properties("RowSource")
If InStr(1, tmpHold, sFind) Then Cnt.Properties("RowSource") = StripSymbol(tmpHold, sFind, sReplace)
Case acOptionGroup
tmpHold = Cnt.Properties("ControlSource")
If InStr(1, tmpHold, sFind) Then Cnt.Properties("ControlSource") = StripSymbol(tmpHold, sFind, sReplace)
Case acListBox
tmpHold = Cnt.Properties("RowSource")
If InStr(1, tmpHold, sFind) Then Cnt.Properties("RowSource") = StripSymbol(tmpHold, sFind, sReplace)
Case acTextBox
tmpHold = Cnt.Properties("ControlSource")
If InStr(1, tmpHold, sFind) Then Cnt.Properties("ControlSource") = StripSymbol(tmpHold, sFind, sReplace)
Case acCheckBox
tmpHold = Cnt.Properties("ControlSource")
If InStr(1, tmpHold, sFind) Then Cnt.Properties("ControlSource") = StripSymbol(tmpHold, sFind, sReplace)
End Select
If tmpHold > "" Then
If InStr(1, tmpHold, sFind) Then
Print #FN, "\par \pard\plain\f3\fs20\cf3\b\i MATCHED IN: " & Cnt.Properties("Name") & ":\plain\f3\fs16\b"
Do Until InStr(1, tmpHold, sFind) <= 0
If Len(tmpHold) <= Len(sFind) Then
tmpHold = sReplace
Exit Do
End If
tmpHold = Left(tmpHold, InStr(1, tmpHold, sFind) - 1) & "\plain\f4\fs20\cf1\ul " & sReplace & "\plain\f4\fs20 " & Right(tmpHold, Len(tmpHold) - (InStr(tmpHold, sFind) - 1) - Len(sFind))
Loop
Print #FN, "\par \pard\li720\plain\f3\fs20 " & tmpHold
Else
Print #FN, "\par \pard \nowidctlpar\adjustright\plain\f3\fs20\cf1\cgrid0\b " & Cnt.Properties("Name") & ":\plain\f3\fs24\cf1\b No Match"
End If
End If
Print #FN, "\par "
Next
Print #FN, "\par "
Next
Print #FN, "\par "
Print #FN, "\par Done: " & Now()
Print #FN, "\par "
Print #FN, "\par "
Queries:
Print #FN, "\par \pard\plain\f4\fs28\cf0\b " & "Queries Search/Replace Replacing """ & sFind & """" & " with: """ & sReplace & """" & "\plain\f2\fs16 "
For i = 0 To db.QueryDefs.Count - 1
Print #FN, "\par \pard \nowidctlpar\adjustright\plain\f3\fs20\cf1\cgrid0\b " & db.QueryDefs(i).Name & ":\plain\f3\fs24\cf1\b"
If InStr(1, db.QueryDefs(i).Sql, sFind) Then
Print #FN, "\par \pard\plain\f3\fs20\cf2\b\i MATCHED IN:" & db.QueryDefs(i).Name & ":\plain\f3\fs16\b"
tmpHold = db.QueryDefs(i).Sql
Do Until InStr(1, tmpHold, sFind) <= 0
tmpHold = Left(tmpHold, InStr(1, tmpHold, sFind) - 1) & "\plain\f4\fs20\cf1\ul " & sReplace & "\plain\f4\fs20 " & Right(tmpHold, Len(tmpHold) - (InStr(tmpHold, sFind) - 1) - Len(sFind))
Loop
Print #FN, "\par \pard\li720\plain\f3\fs20 " & tmpHold
db.QueryDefs(i).Sql = StripSymbol(db.QueryDefs(i).Sql, sFind, sReplace)
End If
Print #FN, "\par "
Next
Print #FN, "\par "
Print #FN, "\par Done: " & Now()
Print #FN, "\par "
Print #FN, "\par "
MODULES:
Dim ModLine As Integer
Dim ModName
Dim sModLine As String
Dim ModLines As Long
Dim h As Long
Print #FN, "\par \pard\plain\f4\fs28\cf0\b " & "Modules Search/Replace Replacing """ & sFind & """" & " with: """ & sReplace & """" & "\plain\f2\fs16 "
For i = 0 To CurrentDb.Containers(2).Documents.Count - 1
If Nz(ModName) <> "" And Nz(ModName, "") <> "Global_Replace" Then DoCmd.Close acModule, ModName, acSaveYes
If CurrentDb.Containers(2).Documents(i).Name <> "Global_Replace" Then
DoCmd.OpenModule CurrentDb.Containers(2).Documents(i).Name
ModName = CurrentDb.Containers(2).Documents(i).Name
If MODULES(ModName).Find(sFind, 1, 1, MODULES(ModName).CountOfLines, 999) = True Then
Print #FN, "\par \pard\plain\f3\fs20\cf2\b\i MATCHED IN: " & ModName & " \plain\f3\fs16\b "
For h = 1 To MODULES(ModName).CountOfLines
If MODULES(ModName).Find(sFind, h, 1, h, 999) = True Then
Call MODULES(ModName).ReplaceLine(h, StripSymbol(MODULES(ModName).Lines(h, 1), sFind, sReplace))
tmpHold = MODULES(ModName).Lines(h, 1)
Do Until InStr(1, tmpHold, sFind) <= 0
tmpHold = Left(tmpHold, InStr(1, tmpHold, sFind) - 1) & "\plain\f4\fs20\cf1\ul " & sReplace & "\plain\f4\fs20 " & Right(tmpHold, Len(tmpHold) - (InStr(tmpHold, sFind) - 1) - Len(sFind))
Loop
Print #FN, "\par " & "Line:" & h & " - " & Trim(tmpHold)
End If
Next
Else
Print #FN, "\par \pard \nowidctlpar\adjustright\plain\f3\fs20\cf1\cgrid0\b " & CurrentDb.Containers(2).Documents(i).Name & ": No Matches \plain\f3\fs24\cf1\b "
End If
End If
Print #FN, "\par "
Next
Print #FN, "\par "
Print #FN, "\par Done: " & Now()
If Nz(ModName) <> "" And Nz(ModName, "") <> "Global_Replace" Then DoCmd.Close acModule, ModName, acSaveYes
Print #FN, "\par }"
Close #FN
End Function
Function StripSymbol(StrIN As String, StripChar As String, Optional ReplaceChar As String = "") As String
Dim xLen As Integer
xLen = Len(StrIN)
Dim x As Integer
x = 1
Do Until x <= 0 Or StripChar = ReplaceChar
x = InStr(1, StrIN, StripChar)
If x > 0 Then StrIN = Left$(StrIN, x - 1) & ReplaceChar & Right$(StrIN, Len(StrIN) - (x - 1) - Len(StripChar))
Loop
StripSymbol = StrIN
End Function