Attribute VB_Name = "bas_crystal_ReplaceSomething_090530"
Option Compare Database
Option Explicit
'
'bas_crystal_ReplaceSomething_090530
'
' This code was originally written by Crystal
' It is not to be altered or distributed,
' except as part of an application.
' You are welcome to use it in any application
' that will be used and given freely,
' provided this copyright notice is left unchanged.
' If you are developing an application to sell,
' you must obtain permission
' to use this code from Crystal.
'
'crystal
'strive4peace2009 at yahoo dot com
' 5-30-09
'
' CONTAINS:
'   ReplaceSomething
'   xIsPropertyDefined

'** NEEDS REFERENCE **
' Microsoft DAO Library
'
' Search queries, forms, and reports.
' Change WORD1 to WORD2 for: SQL, RecordSource, ControlSource, and RowSource.
' Count how many changes were made. Look at Debug window for report.
' Useful to update objects when you change Fieldnames or Tablenames
'
' NOTE:
'  you will need to edit the code to assign WORD1 and WORD2 to what you desire
'
' if you are replacing RESERVED WORDS that are found in SQL Syntax (such as Group),
' you will want to modify code to prompt for changes
'
' Also check out DeepSearch in V-Tools
' http://www.skrol29.com/us/developpements.php
'
'******************************************************************************
'
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ReplaceSomething
Sub ReplaceSomething()
   '
   ' Crystal strive4peace2009 at yahoo.com
   
   ' NEEDS REFERENCE TO:
   ' Microsoft DAO Library
   '
   ' CALLS
   '   xIsPropertyDefined
   '
   ' update objects when you change fieldnames or tablenames
   '
   'this code searches the following:
   ' Queries
   ' Form and Report RecordSources
   ' combo and Listbox RowSources for Forms and Reports
   ' ControlSource for controls on Forms and Reports
   '
   'NOTE: if does NOT search code
   ' press Ctrl-H for the Find/Replace dialog in a VBE window
   '
   ' it will replace WORD1 with WORD2
   ' before running, change WORD1 and WORD2 to whatever you desire
   ' then compile and save
   
   ' then CLICK HERE
   ' and press F5 to run
   
   ' because this does a simple replace
   ', especially if you search on a short word, undesireable changes may happen
   ' back up your database BEFORE running this
   
   On Error GoTo Proc_Err
   
   Dim WORD1 As String _
      , WORD2 As String
      
   '------------------------------ CHANGE THESE TO WHAT YOU DESIRE
   WORD1 = "valueOld"
   WORD2 = "valueNew"
   
   Dim db As DAO.Database _
      , qdf As DAO.QueryDef _
      , frm As Form _
      , rpt As Report _
      , obj As Object _
      , ctrl As Control
      
   Dim mCountQ As Long _
      , mCountF As Long _
      , mCountR As Long _
      , mCountFctrl As Long _
      , mCountRctrl As Long _
      , mCountFrow As Long _
      , mCountRrow As Long _
      , i As Integer _
      , mSaveObject As Integer _
      , s As String
      
   Set db = CurrentDb
      
   Debug.Print "REPLACE " & WORD1 & "  --> " & WORD2
   
   mCountQ = 0
   mCountF = 0
   mCountR = 0
   mCountFctrl = 0
   mCountRctrl = 0
   mCountFrow = 0
   mCountRrow = 0
      
   ' close all open queries
   ' ignore errors
   On Error Resume Next
   For i = db.QueryDefs.Count - 1 To 0 Step -1
      DoCmd.Close acQuery, db.QueryDefs(i).Name, acSaveNo
   Next
   On Error GoTo Proc_Err
   
   'close open forms
   For i = Forms.Count - 1 To 0 Step -1
      DoCmd.Close acForm, Forms(i).Name, acSaveNo
   Next

   'close open reports
   For i = Reports.Count - 1 To 0 Step -1
      DoCmd.Close acReport, Reports(i).Name, acSaveNo
   Next

   '--------------------------------- Queries
   Debug.Print "* QUERIES"
   For Each qdf In db.QueryDefs
      If InStr(qdf.SQL, WORD1) > 0 Then
         qdf.SQL = Replace(qdf.SQL, WORD1, WORD2)
         mCountQ = mCountQ + 1
         Debug.Print Space(3) & mCountQ & " " & qdf.Name
      End If
   Next qdf
   
   '--------------------------------- Forms
   'loop through all the forms
   
   Debug.Print "* FORMS"
   For Each obj In CurrentProject.AllForms
      mSaveObject = acSaveNo
      DoCmd.OpenForm obj.Name, acViewDesign
      Set frm = Forms(obj.Name)
      
      s = Space(3) & obj.Name
      If InStr(frm.RecordSource, WORD1) > 0 Then
         frm.RecordSource = Replace(frm.RecordSource, WORD1, WORD2)
         mCountF = mCountF + 1
         s = s & " -- " & mCountF & " RecordSource"
         mSaveObject = acSaveYes
      End If

      For Each ctrl In frm.Controls
         'see if control has a ControlSource
         If xIsPropertyDefined("ControlSource", ctrl) = True Then
            'Properties("ControlSource") used
            'so this will alsowork with Image controls (2007)
            If InStr(ctrl.Properties("ControlSource"), WORD1) > 0 Then
               mCountFctrl = mCountFctrl + 1
               s = s & vbCrLf & Space(5) & mCountFctrl & " " & ctrl.Name & " - ControlSource"
               ctrl.Properties("ControlSource") _
                  = Replace(ctrl.Properties("ControlSource"), WORD1, WORD2)
            End If
         End If
         
         Select Case ctrl.ControlType
         Case acComboBox, acListBox
            If InStr(ctrl.RowSource, WORD1) > 0 Then
               ctrl.RowSource = Replace(ctrl.RowSource, WORD1, WORD2)
               mCountFrow = mCountFrow + 1
               s = s & vbCrLf & Space(6) & mCountFrow & " " & ctrl.Name & " - RowSource"
               mSaveObject = acSaveYes
            End If
         End Select
      Next ctrl
      
      DoCmd.Close acForm, obj.Name, mSaveObject

      If mSaveObject = acSaveYes Then
         Debug.Print s
      End If
   Next obj
      

   '--------------------------------- Reports
   
   Debug.Print "* REPORTS"
   For Each obj In CurrentProject.AllReports
      mSaveObject = acSaveNo
      DoCmd.OpenReport obj.Name, acViewDesign
      Set rpt = Reports(obj.Name)
      
      s = Space(3) & obj.Name
      If InStr(rpt.RecordSource, WORD1) > 0 Then
         rpt.RecordSource = Replace(rpt.RecordSource, WORD1, WORD2)
         mCountR = mCountR + 1
         s = s & " -- " & mCountR & " RecordSource"
         mSaveObject = acSaveYes
      End If

      For Each ctrl In rpt.Controls
         'see if control has a ControlSource
         If xIsPropertyDefined("ControlSource", ctrl) = True Then
            If InStr(ctrl.Properties("ControlSource"), WORD1) > 0 Then
               mCountRctrl = mCountRctrl + 1
               s = s & vbCrLf & Space(5) & mCountRctrl & " " & ctrl.Name & " - ControlSource"
               ctrl.Properties("ControlSource") _
                  = Replace(ctrl.Properties("ControlSource"), WORD1, WORD2)
            End If
         End If
         
         Select Case ctrl.ControlType
         Case acComboBox, acListBox
            If InStr(ctrl.RowSource, WORD1) > 0 Then
               ctrl.RowSource = Replace(ctrl.RowSource, WORD1, WORD2)
               mCountRrow = mCountRrow + 1
               s = s & vbCrLf & Space(6) & mCountRrow & " " & ctrl.Name & " - RowSource"
               mSaveObject = acSaveYes
            End If
         End Select
      Next ctrl
      
      DoCmd.Close acReport, obj.Name, mSaveObject

      If mSaveObject = acSaveYes Then
         Debug.Print s
      End If
   
   Next obj
   
   Debug.Print "--------------SUMMARY-------------"
   Debug.Print "Queries: " & mCountQ
   Debug.Print "Forms: " & mCountF & " RecordSources"
   Debug.Print Space(10) & mCountFctrl & " Control Sources"
   Debug.Print Space(10) & mCountFrow & " Rowsources"
   Debug.Print "Reports: " & mCountR & " RecordSources"
   Debug.Print Space(10) & mCountRctrl & " Control Sources"
   Debug.Print Space(10) & mCountRrow & " Rowsources"

   
Proc_Exit:
   Set qdf = Nothing
   Set ctrl = Nothing
   Set frm = Nothing
   Set rpt = Nothing
   Set obj = Nothing
   Set db = Nothing
   
   Exit Sub
  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   ReplaceSomething"

   Resume Proc_Exit
   Resume
End Sub
 
'~~~~~~~~~~~~~~~~~~~~~ xIsPropertyDefined
' this is a copy of a procedure in my general libraries,
'which is why it the name os prefaced with x
Public Function xIsPropertyDefined( _
   ByVal pPropName As String _
   , Optional obj As Object _
   ) As Boolean
 
   'Crystal (strive4peace2009 at yahoo.com)
   '
   'PARAMETERS
   ' Obj can be a database, a Tabledef, a Field...
   ' if it is missing, CurrentDb is used
   '
   
   On Error GoTo Proc_Err
   
   xIsPropertyDefined = False
   
   Dim prp As DAO.Property
      
   If obj Is Nothing Then
      Set obj = CurrentDb
   End If
   
   For Each prp In obj.Properties
      If prp.Name = pPropName Then
         xIsPropertyDefined = True
         GoTo Proc_Exit
      End If
   Next prp
   
Proc_Exit:
   Set prp = Nothing
   Exit Function
  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   xIsPropertyDefined"

   Resume Proc_Exit

   'if you want to single-step code to find error, CTRL-Break at MsgBox
   'then set this to be the next statement
   Resume
 
  
End Function