Renaming

[BillCo]

I'm updating a legacy app with table naming that makes baby jesus cry.
It's a bit of a spider web though... no telling when and where the
tables will be called by name. So I wrote this for renaming tables (I
guess it would work for queries also). It changes the table name,
changes the table name, queries that refer to it, form and report
control sources, combo and list box row sources etc.

Anyone inspired enough to figure out how to make it update modules and
macros? Not sure if it's possible...
Function renameTable(strOldName As String, strNewName As String)
'************************************************* ***
'Bill Coleman
'24th May 2006
'Renames table and updates queries for new table name
'************************************************* ***
On Error GoTo errHandler

Dim qryDef As QueryDef
Dim docX As Document
Dim rptX As Report
Dim ctrlX As Control
Dim strTmpSQL As String
Dim intErrCount As Integer
Dim db As DAO.Database

Set db = CurrentDb
intErrCount = 0

'Table
DoCmd.Rename strNewName, acTable, strOldName

'Queries
For Each qryDef In CurrentDb.QueryDefs
If InStr(qryDef.sql, strOldName) Then
strTmpSQL = ReplaceName(qryDef.sql, strOldName, strNewName)
qryDef.sql = strTmpSQL
End If
Next qryDef

DoCmd.SetWarnings False 'automatically save changes

'Reports
For Each docX In db.Containers("Reports").Documents
DoCmd.OpenReport docX.Name, acDesign
If InStr(Reports(0).recordsource, strOldName) Then
Reports(0).recordsource = Replace(Reports(0).recordsource,
strOldName, strNewName)
End If
For Each ctrlX In Reports(0)
If ctrlX.ControlType = acTextBox Then
If InStr(ctrlX.ControlSource, strOldName) Then
ctrlX.ControlSource = ReplaceName(ctrlX.ControlSource, strOldName,
strNewName)
ElseIf ctrlX.ControlType = acComboBox Then
If InStr(ctrlX.RowSource, strOldName) Then
ctrlX.RowSource = Replace(ctrlX.RowSource, strOldName, strNewName)
End If
Next ctrlX
DoCmd.Close acReport, Reports(0).Name
Next docX

'Forms
For Each docX In db.Containers("forms").Documents
DoCmd.OpenForm docX.Name, acDesign
If InStr(Forms(0).recordsource, strOldName) Then
Forms(0).recordsource = Replace(Forms(0).recordsource,
strOldName, strNewName)
DoEvents
End If
For Each ctrlX In Forms(0)
If ctrlX.ControlType = acTextBox Then
If InStr(ctrlX.ControlSource, strOldName) Then
ctrlX.ControlSource = ReplaceName(ctrlX.ControlSource, strOldName,
strNewName)
ElseIf ctrlX.ControlType = acComboBox Or ctrlX.RowSource =
acListBox Then
If InStr(ctrlX.RowSource, strOldName) Then
ctrlX.RowSource = Replace(ctrlX.RowSource, strOldName, strNewName)
End If
Next ctrlX
DoCmd.Close acForm, Forms(0).Name
Next docX

DoCmd.SetWarnings True

exitHere:
MsgBox intErrCount
Exit Function

errHandler:
intErrCount = intErrCount + 1
Debug.Print Err.Number & ", " & Err.Description
Resume Next

End Function

Public Function ReplaceName(ByVal strIn As String, strFind As String, _
Optional strReplace As String, _
Optional intRepeatCheck As Integer) As String
'******************************************
'Bill Coleman
'24th May 2006
'Replaces instances of string within string
'but only when not part of another word
'******************************************
Dim intSpot As Integer, intCounter As Integer, intStart As Integer
Dim sLeftChar, sRightChar As String

If IsMissing(strReplace) Then strReplace = ""
If IsMissing(intRepeatCheck) Then intRepeatCheck = 1000
If intRepeatCheck = 0 Then intRepeatCheck = 1000
intStart = 1

For intCounter = 1 To intRepeatCheck
intSpot = InStr(intStart, strIn, strFind, vbTextCompare)
'vbTextCompare not case sensitive
If intSpot > 0 Then
sLeftChar = Right(Left(strIn, intSpot - 1), 1)
sRightChar = Left(Mid(strIn, intSpot + Len(strFind)), 1)
If ((sLeftChar = " ") Or (sLeftChar = """") Or _
(sLeftChar = "(") Or (sLeftChar = "[") Or _
(sLeftChar = "") Or (sLeftChar = "=") Or _
(sLeftChar = ".")) And _
((sRightChar = " ") Or (sRightChar = """") Or _
(sRightChar = "(") Or (sRightChar = "[") Or _
(sRightChar = "") Or (sRightChar = "=") Or _
(sRightChar = ".")) Then
'only " xyz ", "[xyz]", "(xyz.", "xyz=", '"xyz"' etc
strIn = Left(strIn, intSpot - 1) & strReplace &
Mid(strIn, intSpot + Len(strFind))
intStart = intSpot + Len(strReplace) + 1
End If
Else
Exit For
End If
Next
ReplaceName = strIn

End Function

[Rick Wannall]

These days, if you open Tools | Options, go to the General tab, and check
everything under Name Auto Correct, you have a good chance that many names
changes can be made and propagated through queries and form/report
recordsources. To my amazement, I just found that changing a field name in
a table or changing a table name is recorded, even if you use vb to make the
change.

References in code are still a problem.

I think that Speed Ferret (http://www.speedferret.com, $200) takes care of
the source code problem, plus gives you some pretty nifty other abilities.

If you don't go for built-in or Speed Ferret, and try to take it on
yourself, be very careful.

First question, when you say that you are changing "queries that refer to
it", do you mean that you are opening the querydef, parsing the SQL, and
replacing old table names with new table names? If not, then you're going
to be in for a shock the first time you try to run a query and find out that
your tables (as named in the queries) do not exist. Good luck restoring
your queries to operational status.

(I'll dispense with one thing first: I would't even bother with table
naming oddities myself on a wholesale basis. So someone used weird names.
So what? Put your own desription in the description field and get on with
life. But hey, that's me.)

If I were going to take on the renaming of all the tables without Speed
Ferret, I'd do it in phases. I'd make a list of the table names in another
table. I'd add a mark to indicate those whose names just have to change.
I'd add a column to contain the new name I intend to use.

I would do the next step with about 20 lines of code in vb, but it would
work doing it manually just as well.

For each table whose name just must change, I'd create a query that selects
from the old name and save the query as the new name. Each query is just
"Select t.* From oldtablename As t". That's it. Now I have all the lovely
new table names in place and haven't butchered anything in my application.

Next, I might use some vb to open forms or reports in design view and notice
if the recordsource is one of the old names. When I find one, I would
simply replace it with the new name.

Next, I would put together a query based on msysobjects and msysqueries so
that I could find all references in queries to any of the old table names.
I would probably not try to use VB to go through querydefs and automate
table name changes. Way to many variables in the parsing necessary.
However, driven by my query on msysobjects and msysqueries I could filter
for a single old table name and see all queries that use it. I would open
each in turn and replace references to the old table name with the new table
name. The query will still work because I have a query under the new name.

And so on and so on. YOu can even create a form with a listboxes to display
the list of all queries, and use code for instance in a double-click event
to open the query in design view, etc etc.

And as you pointed out, you have to search through modules to find explicit
code references to the old table names. While you're cleaning this up, why
don't you make a list of public constants set to the table names and replace
hard-coded referenes to name strings with references to the costants. Then
you don't have to deal with names everywhere on the next pass of something
like this.

Eventually, when you are pretty sure you have ferreted out all references to
the old table names, make a final backup copy (I assume you will back up
frequently doing stuff like this) and then start removing the queries and
renaming old tables to their new names.


"BillCo" <co**********@gmail.com> wrote in message
news:11**********************@u72g2000cwu.googlegr oups.com...

I'm updating a legacy app with table naming that makes baby jesus cry.
It's a bit of a spider web though... no telling when and where the
tables will be called by name. So I wrote this for renaming tables (I
guess it would work for queries also). It changes the table name,
changes the table name, queries that refer to it, form and report
control sources, combo and list box row sources etc.

Anyone inspired enough to figure out how to make it update modules and
macros? Not sure if it's possible...
Function renameTable(strOldName As String, strNewName As String)
'************************************************* ***
'Bill Coleman
'24th May 2006
'Renames table and updates queries for new table name
'************************************************* ***
On Error GoTo errHandler

Dim qryDef As QueryDef
Dim docX As Document
Dim rptX As Report
Dim ctrlX As Control
Dim strTmpSQL As String
Dim intErrCount As Integer
Dim db As DAO.Database

Set db = CurrentDb
intErrCount = 0

'Table
DoCmd.Rename strNewName, acTable, strOldName

'Queries
For Each qryDef In CurrentDb.QueryDefs
If InStr(qryDef.sql, strOldName) Then
strTmpSQL = ReplaceName(qryDef.sql, strOldName, strNewName)
qryDef.sql = strTmpSQL
End If
Next qryDef

DoCmd.SetWarnings False 'automatically save changes

'Reports
For Each docX In db.Containers("Reports").Documents
DoCmd.OpenReport docX.Name, acDesign
If InStr(Reports(0).recordsource, strOldName) Then
Reports(0).recordsource = Replace(Reports(0).recordsource,
strOldName, strNewName)
End If
For Each ctrlX In Reports(0)
If ctrlX.ControlType = acTextBox Then
If InStr(ctrlX.ControlSource, strOldName) Then
ctrlX.ControlSource = ReplaceName(ctrlX.ControlSource, strOldName,
strNewName)
ElseIf ctrlX.ControlType = acComboBox Then
If InStr(ctrlX.RowSource, strOldName) Then
ctrlX.RowSource = Replace(ctrlX.RowSource, strOldName, strNewName)
End If
Next ctrlX
DoCmd.Close acReport, Reports(0).Name
Next docX

'Forms
For Each docX In db.Containers("forms").Documents
DoCmd.OpenForm docX.Name, acDesign
If InStr(Forms(0).recordsource, strOldName) Then
Forms(0).recordsource = Replace(Forms(0).recordsource,
strOldName, strNewName)
DoEvents
End If
For Each ctrlX In Forms(0)
If ctrlX.ControlType = acTextBox Then
If InStr(ctrlX.ControlSource, strOldName) Then
ctrlX.ControlSource = ReplaceName(ctrlX.ControlSource, strOldName,
strNewName)
ElseIf ctrlX.ControlType = acComboBox Or ctrlX.RowSource =
acListBox Then
If InStr(ctrlX.RowSource, strOldName) Then
ctrlX.RowSource = Replace(ctrlX.RowSource, strOldName, strNewName)
End If
Next ctrlX
DoCmd.Close acForm, Forms(0).Name
Next docX

DoCmd.SetWarnings True

exitHere:
MsgBox intErrCount
Exit Function

errHandler:
intErrCount = intErrCount + 1
Debug.Print Err.Number & ", " & Err.Description
Resume Next

End Function

Public Function ReplaceName(ByVal strIn As String, strFind As String, _
Optional strReplace As String, _
Optional intRepeatCheck As Integer) As String
'******************************************
'Bill Coleman
'24th May 2006
'Replaces instances of string within string
'but only when not part of another word
'******************************************
Dim intSpot As Integer, intCounter As Integer, intStart As Integer
Dim sLeftChar, sRightChar As String

If IsMissing(strReplace) Then strReplace = ""
If IsMissing(intRepeatCheck) Then intRepeatCheck = 1000
If intRepeatCheck = 0 Then intRepeatCheck = 1000
intStart = 1

For intCounter = 1 To intRepeatCheck
intSpot = InStr(intStart, strIn, strFind, vbTextCompare)
'vbTextCompare not case sensitive
If intSpot > 0 Then
sLeftChar = Right(Left(strIn, intSpot - 1), 1)
sRightChar = Left(Mid(strIn, intSpot + Len(strFind)), 1)
If ((sLeftChar = " ") Or (sLeftChar = """") Or _
(sLeftChar = "(") Or (sLeftChar = "[") Or _
(sLeftChar = "") Or (sLeftChar = "=") Or _
(sLeftChar = ".")) And _
((sRightChar = " ") Or (sRightChar = """") Or _
(sRightChar = "(") Or (sRightChar = "[") Or _
(sRightChar = "") Or (sRightChar = "=") Or _
(sRightChar = ".")) Then
'only " xyz ", "[xyz]", "(xyz.", "xyz=", '"xyz"' etc
strIn = Left(strIn, intSpot - 1) & strReplace &
Mid(strIn, intSpot + Len(strFind))
intStart = intSpot + Len(strReplace) + 1
End If
Else
Exit For
End If
Next
ReplaceName = strIn

End Function

[(PeteCresswell)]

Per Rick Wannall:

I think that Speed Ferret (http://www.speedferret.com, $200) takes care of
the source code problem, plus gives you some pretty nifty other abilities.

Also worth a look: FindAndReplace from Rick Fischer

http://www.rickworld.com/
I've used SpeedFerret, but I find Rick's utility faster and easier to use. It's
also costs less....
--
PeteCresswell

[BillCo]

>These days, if you open Tools | Options, go to the General tab, and check

everything under Name Auto Correct
apart from turning the app into a scene from cocoon, name auto correct
only goes so far. would be ok if it didnt have any forms or reports or
code or macros.
First question, when you say that you are changing "queries that refer to
it", do you mean that you are opening the querydef, parsing the SQL, and
replacing old table names with new table names? If not, then you're going
to be in for a shock the first time you try to run a query and find out that
your tables (as named in the queries) do not exist.
....hmm didnt read the code i posted then ;)
For each table whose name just must change, I'd create a query that selects
from the old name and save the query as the new name. Each query is just
"Select t.* From oldtablename As t". That's it. Now I have all the lovely
new table names in place and haven't butchered anything in my application. <snip>and then start removing the queries and renaming old tables to their new names.
doubling the number of queries (already at 600ish) with a cryptic
naming scheme only to remove them again is not really a runner, this
will only hide problems that will surface once the queries are removed
and greatly complicate things along the way.
Next, I might use some vb to open forms or reports in design view and notice
if the recordsource is one of the old names. When I find one, I would
simply replace it with the new name.
seriously, dude - READ THE CODE!!!! it takes care of all of that -
querydefs, forms, reports, recordsources, control sources...
msysobjects and msysqueries so <snip>even create a form with a listboxes to display the list of all queries, and use code for
instance in a double-click event to open the query in design view, etc etc.
....or i could select a query in the db window and click edit... (which
i dont even need to do because i've already looped through them all in
code and changed them)
make a list of public constants set to the table names and replace
hard-coded referenes to name strings with references to the costants.

you mean:
Public Const pStrTblMyTableName = "tblMyTableName"

so that i can change this to to:
Public Const pStrTblMyTableName = "tblNOTMyTableName"

....seriously, trying to clear things up here. Unify, homognise and
simplify.

ok, I appreciate your attempting to help here - you didnt have to
reply, so thanks for your time. But next time you feel moved to offer
your tupence, RTFP... I'll check out speed ferret thanks. That might
have what I need for code and macros. if not, there's always find and
replace - i was just trying to create a on click comprehensive solution
to table renaming.

[Larry Linson]

"BillCo" <co**********@gmail.com> wrote

...hmm didnt read the code i posted then ;)

Many, possibly most, people who help in the newsgroups just don't have the
time or energy to spend reading lengthy (or even not-so-lengthy) code posts
unless the poster has a specific error they are encountering that may show
up by "skimming" what's there.

Even so, we do our best to help, so please don't hold it against us if we
can't provide the level of support you'd like.

For good suggestions on effective use of newsgroups, take a look at the FAQ,
http://www.mvps.org/access.

Your code, it appears to me, is replicating what has been done in commercial
and shareware products that many use, and have suggested to you. There are
many "nooks and crannies" inside an Access database where information may
"hide," so be prepared for lots of testing. Third-party tools such as Speed
Ferret (http://www.moshannon.com) and Find and Replace
(http://www.rickworld.com) have the advantage of having been around, used by
lots of developers for many years, and have had the opportunity to fill in
the gaps that might have been there in their early versions.

Best of luck with your project.

Larry Linson
Microsoft Access MVP

[Lyle Fairfield]

This code is probably seven or eight years old. Of course, it's for
ac97. Perhaps there's something useful for you within it.
I have a 2K version as well. TTBOMK neither has seen the light of day
in this century. Of course, this code is not in my current style.

Private Declare Function EbIsValidIdent _
Lib "vba332.dll" (ByVal lpString As Long, ByRef lBool As Long) As Long

' separator that is invalid as part of field name
Const strSeparator As String = "`"

Dim mStrPath As String
Dim mLngCompareMethod As Long

Sub DoSearchAndReplace()
Call SearchAndReplace("blah", "blah2")
End Sub

Sub SearchAndReplace( _
ByVal vStrReplaceWhat As String, _
ByVal vStrReplaceWith As String)

If Not ((IsAValidIdentifier(vStrReplaceWith)) Or
(InStr(vStrReplaceWith, " ") <> 0)) Then
MsgBox Chr(34) & vStrReplaceWith & Chr(34) & " Is Not A Valid
Identifier!" _
& vbCrLf & vbCrLf _
& "Please, Choose Another Replacment String.", _
vbExclamation, "Cyber-River Solutions"
Exit Sub
End If

Dim bar As Object
Dim booStatusBarState As Boolean
Dim cnt As Container
Dim ctl As Object
Dim dbs As Database
Dim doc As Document
Dim fld As Field
Dim idx As Index
Dim lngCounter As Long
Dim qry As QueryDef
Dim strSQL As String
Dim tdf As TableDef

On Error GoTo SearchAndReplaceErr:

' be sure database is compacted ...
If MsgBox("Database must be compacted" _
& vbCrLf _
& "and this module must be saved" _
& vbCrLf _
& "before Search and Replace is activated." _
& vbCrLf & vbCrLf _
& "Have these been completed?", _
vbQuestion Or vbYesNo, _
"FDDBA") _
= vbNo Then Exit Sub

' close objects
Do While Forms.Count > 0
DoCmd.Close acForm, Forms(Forms.Count - 1).Name
Loop
Do While Modules.Count > 0
DoCmd.Close acModule, Modules(Modules.Count - 1).Name
Loop
Do While Reports.Count > 0
DoCmd.Close acForm, Reports(Reports.Count - 1).Name
Loop

' manage the status bar
booStatusBarState = GetOption("Show Status Bar")
SetOption "Show Status Bar", True

' get temp path
mStrPath = Environ("Temp")
If Right(mStrPath, 1) <> "\" Then mStrPath = mStrPath & "\"

Set dbs = CurrentDb()
With dbs
SysCmd acSysCmdInitMeter, "Processing Relations",
..TableDefs.Count
RecordRelations
RemoveRelations
SysCmd acSysCmdInitMeter, "Processing Tables", .TableDefs.Count
lngCounter = 1
For Each tdf In .TableDefs
SysCmd acSysCmdUpdateMeter, lngCounter
lngCounter = lngCounter + 1
With tdf
If Left(.Name, 4) <> "MSys" _
And Left(.Name, 1) <> "~" Then
If .Name = "SwitchBoard Items" Then
strSQL = _
"UPDATE [Switchboard Items] " _
& "SET " _
& "ItemText = strTran(ItemText, '" _
& vStrReplaceWhat & "', '" _
& vStrReplaceWith & "'), " _
& "Argument = strTran(Argument, '" _
& vStrReplaceWhat & "', '" _
& vStrReplaceWith & "');"
dbs.Execute (strSQL)
Else
If .Connect = "" Then
For Each fld In .Fields
With fld
.Name = strTran(.Name,
vStrReplaceWhat, vStrReplaceWith)
End With
Next fld
For Each idx In tdf.Indexes
With idx
.Name = strTran(.Name,
vStrReplaceWhat, vStrReplaceWith)
End With
Next idx
.Name = strTran(.Name, vStrReplaceWhat,
vStrReplaceWith)
Else
DoCmd.Rename strTran(.Name,
vStrReplaceWhat, vStrReplaceWith), _
acTable, .Name
End If
End If
End If
End With
Next tdf

SysCmd acSysCmdInitMeter, "Processing Queries",
..QueryDefs.Count
lngCounter = 1
For Each qry In .QueryDefs
SysCmd acSysCmdUpdateMeter, lngCounter
lngCounter = lngCounter + 1
With qry
Call Replace(acQuery, .Name, vStrReplaceWhat,
vStrReplaceWith)
End With
Next qry

Set qry = Nothing

Set cnt = .Containers("Forms")
SysCmd acSysCmdInitMeter, "Processing Forms",
cnt.Documents.Count
lngCounter = 1
For Each doc In cnt.Documents
SysCmd acSysCmdUpdateMeter, lngCounter
lngCounter = lngCounter + 1
With doc
Call Replace(acForm, .Name, vStrReplaceWhat,
vStrReplaceWith)
End With
Next doc

Set cnt = .Containers("Modules")
SysCmd acSysCmdInitMeter, "Processing Modules",
cnt.Documents.Count
lngCounter = 1
For Each doc In cnt.Documents
SysCmd acSysCmdUpdateMeter, lngCounter
lngCounter = lngCounter + 1
With doc
If .Name <> "basSearchAndReplace" Then _
Call Replace(acModule, .Name, vStrReplaceWhat,
vStrReplaceWith)
End With
Next doc

Set cnt = .Containers("Reports")
SysCmd acSysCmdInitMeter, "Processing Reports",
cnt.Documents.Count
lngCounter = 1
For Each doc In cnt.Documents
SysCmd acSysCmdUpdateMeter, lngCounter
lngCounter = lngCounter + 1
With doc
Call Replace(acReport, .Name, vStrReplaceWhat,
vStrReplaceWith)
End With
Next doc

Set cnt = .Containers("Scripts")
SysCmd acSysCmdInitMeter, "Processing Macros",
cnt.Documents.Count
lngCounter = 1
For Each doc In cnt.Documents
SysCmd acSysCmdUpdateMeter, lngCounter
lngCounter = lngCounter + 1
With doc
Call Replace(acMacro, .Name, vStrReplaceWhat,
vStrReplaceWith)
End With
Next doc

SysCmd acSysCmdInitMeter, "Restoring Relations",
..TableDefs.Count
RestoreRelations vStrReplaceWhat, vStrReplaceWith

End With

lngCounter = 0
For Each bar In CommandBars
If Not bar.BuiltIn = True Then lngCounter = lngCounter + 1
Next bar

SysCmd acSysCmdInitMeter, "Processing Command Bars", lngCounter
lngCounter = 1
For Each bar In CommandBars
SysCmd acSysCmdUpdateMeter, lngCounter
lngCounter = lngCounter + 1
With bar
If Not .BuiltIn = True Then
For Each ctl In .Controls
With ctl
If Not .BuiltIn = True Then
.Caption = strTran(.Caption,
vStrReplaceWhat, vStrReplaceWith)
.DescriptionText =
strTran(.DescriptionText, vStrReplaceWhat, vStrReplaceWith)
.OnAction = strTran(.OnAction,
vStrReplaceWhat, vStrReplaceWith)
.ToolTipText = strTran(.ToolTipText,
vStrReplaceWhat, vStrReplaceWith)
End If
End With
Next ctl
.Name = strTran(.Name, vStrReplaceWhat,
vStrReplaceWith)
End If
End With
Next bar

MsgBox "All Done" _
& vbCrLf & vbCrLf _
& "You should Compact the Database Now!", _
vbInformation, _
"Replacing " _
& Chr(34) & StrConv(vStrReplaceWhat, vbProperCase) & Chr(34) _
& " with " _
& Chr(34) & StrConv(vStrReplaceWith, vbProperCase) & Chr(34)

SearchAndReplaceExit:

Set idx = Nothing
Set fld = Nothing
Set tdf = Nothing
Set doc = Nothing
Set cnt = Nothing
Set ctl = Nothing
Set bar = Nothing
Set dbs = Nothing

SysCmd (acSysCmdRemoveMeter)

SetOption "Show Status Bar", booStatusBarState
Exit Sub

SearchAndReplaceErr:
MsgBox Err.Description, vbCritical, "Search and Replace"
Resume Next

End Sub

Private Sub Replace( _
ByVal lngObjectType As Long, _
ByVal strName As String, _
ByVal vStrReplaceWhat As String, _
ByVal vStrReplaceWith As String)

Dim lngBufferLength As Long
Dim intFromFileNumber As Integer
Dim intToFileNumber As Integer
Dim strBuffer As String
Dim strFromPath As String
Dim strLeftPathPart As String
Dim strToPath As String

strLeftPathPart = AlphaNumericOnly(mStrPath & strName)
strFromPath = strLeftPathPart & ".txt"
strToPath = strLeftPathPart & " Revised.txt"

Close

Application.SaveAsText lngObjectType, strName, strFromPath
lngBufferLength = FileLen(strFromPath)

intFromFileNumber = FreeFile
Open strFromPath For Binary As intFromFileNumber

intToFileNumber = FreeFile
Open strToPath For Binary As intToFileNumber

strBuffer = Input(lngBufferLength, #intFromFileNumber)
strBuffer = strTran(strBuffer, vStrReplaceWhat, vStrReplaceWith)
Put #intToFileNumber, , strBuffer

Close #intFromFileNumber
Close #intToFileNumber

Kill strFromPath
DoCmd.DeleteObject lngObjectType, strName

strName = strTran(strName, vStrReplaceWhat, vStrReplaceWith)
Application.LoadFromText lngObjectType, strName, strToPath

Kill strToPath

End Sub

Private Sub RecordRelations()
Dim dbs As Database
Dim fld As Field
Dim lngIterator As Long
Dim rcs As Recordset
Dim rel As Relation

Set dbs = CurrentDb()

With dbs
On Error Resume Next
dbs.Execute "DROP TABLE SearchAndReplaceRelations;"
On Error GoTo 0

.TableDefs.Refresh

.Execute "CREATE TABLE SearchAndReplaceRelations " _
& "([Name] TEXT, [Table] TEXT, [Fields] LONGTEXT,
[ForeignTable] TEXT, " _
& "[ForeignFields] LONGTEXT, [Attributes] INTEGER);"

.TableDefs.Refresh

Set rcs = .OpenRecordset("SearchAndReplaceRelations")

For Each rel In dbs.Relations

With rel
rcs.AddNew
rcs!Name = .Name
rcs!Table = .Properties("Table")
For lngIterator = 0 To .Fields.Count - 1
Set fld = .Fields(lngIterator)
rcs!Fields = rcs!Fields & fld.Name
rcs!ForeignFields = rcs!ForeignFields &
fld.ForeignName
If lngIterator <> .Fields.Count - 1 Then
rcs!Fields = rcs!Fields & strSeparator
rcs!ForeignFields = rcs!ForeignFields &
strSeparator
End If
Next lngIterator
rcs!ForeignTable = .Properties("ForeignTable")
rcs!Attributes = .Attributes
rcs.Update
End With

Next rel

End With

Set rel = Nothing
Set rcs = Nothing
Set dbs = Nothing

End Sub

Sub RemoveRelations()
Dim dbs As Database
Set dbs = CurrentDb()
With dbs
Do While .Relations.Count > 0
.Relations.Delete .Relations(.Relations.Count - 1).Name
Loop
.Relations.Refresh
End With
Set dbs = Nothing
End Sub

Sub RestoreRelations( _
ByVal vStrReplaceWhat As String, _
ByVal vStrReplaceWith As String)
Dim colFields As Collection
Dim colForeignFields As Collection
Dim dbs As Database
Dim fld As Field
Dim lngIterator As Long
Dim rcs As Recordset
Dim rel As Relation
Dim strFields As String
Dim strForeignFields As String
Dim strForeignTable As String
Dim strName As String
Dim strTable As String

Set dbs = CurrentDb()

Set rcs = dbs.OpenRecordset( _
"SELECT * FROM SearchAndReplaceRelations ORDER BY Table DESC,
ForeignTable")

With rcs
If .RecordCount <> 0 Then
.MoveFirst
Do
strFields = strTran(!Fields, vStrReplaceWhat,
vStrReplaceWith)
strForeignFields = strTran(!ForeignFields,
vStrReplaceWhat, vStrReplaceWith)
strForeignTable = strTran(!ForeignTable,
vStrReplaceWhat, vStrReplaceWith)
strName = strTran(!Name, vStrReplaceWhat,
vStrReplaceWith)
strTable = strTran(!Table, vStrReplaceWhat,
vStrReplaceWith)
Set rel = dbs.CreateRelation(strName, strTable,
strForeignTable, !Attributes)
Set fld = rel.CreateField(strFields)
Set colFields = ParsedString(strFields, strSeparator)
Set colForeignFields = ParsedString(strForeignFields,
strSeparator)
For lngIterator = 1 To colFields.Count
Set fld = rel.CreateField(colFields(lngIterator))
fld.ForeignName = colForeignFields(lngIterator)
rel.Fields.Append fld
Next lngIterator
dbs.Relations.Append rel
dbs.Relations.Refresh
rcs.MoveNext
Loop Until rcs.EOF
End If
End With

Set rcs = Nothing
Set dbs = Nothing

End Sub

Private Function strTran( _
ByVal vStrReplaceIn As String, _
ByVal vStrReplaceWhat As String, _
ByVal vStrReplaceWith As String) As String
Dim lngPosition As Long
' Compare Method default
If mLngCompareMethod = 0 Then mLngCompareMethod = vbTextCompare
lngPosition = InStr(1, vStrReplaceIn, vStrReplaceWhat,
mLngCompareMethod)
Do While lngPosition <> 0
strTran = strTran & Left(vStrReplaceIn, lngPosition - 1) &
vStrReplaceWith
vStrReplaceIn = Mid(vStrReplaceIn, lngPosition +
Len(vStrReplaceWhat))
lngPosition = InStr(1, vStrReplaceIn, vStrReplaceWhat,
mLngCompareMethod)
Loop
strTran = strTran & vStrReplaceIn
End Function

Private Function ParsedString( _
ByVal vString As String, _
ParamArray paSeparators() As Variant) As Collection
Dim colParsedString As New Collection
Dim lngLength As Long
Dim lngPosition As Long
Dim strPart As String
Dim ubiquitousSeparator As String
Dim varSeparator As Variant
' Compare Method default
If mLngCompareMethod = 0 Then mLngCompareMethod = vbTextCompare
' something one hopes isn't in the string
ubiquitousSeparator = "/" & Chr(255) & "/"
Do While InStr(1, vString, ubiquitousSeparator, mLngCompareMethod)
<> 0
ubiquitousSeparator = ubiquitousSeparator & ubiquitousSeparator
Loop
lngLength = Len(ubiquitousSeparator)
For Each varSeparator In paSeparators
vString = strTran(vString, varSeparator, ubiquitousSeparator)
Next varSeparator
lngPosition = InStr(1, vString, ubiquitousSeparator,
mLngCompareMethod)
Do While lngPosition = 1
vString = Mid(vString, lngPosition + lngLength)
lngPosition = InStr(1, vString, ubiquitousSeparator,
mLngCompareMethod)
Loop
Do While lngPosition <> 0
strPart = Left(vString, lngPosition - 1)
If strPart <> "" Then colParsedString.Add Left(vString,
lngPosition - 1)
vString = Mid(vString, lngPosition + lngLength)
lngPosition = InStr(1, vString, ubiquitousSeparator,
mLngCompareMethod)
Do While lngPosition = 1
vString = Mid(vString, lngPosition + lngLength)
lngPosition = InStr(1, vString, ubiquitousSeparator,
mLngCompareMethod)
Loop
Loop
If vString <> "" Then colParsedString.Add vString
Set ParsedString = colParsedString
End Function

Private Function AlphaNumericOnly(ByVal vString As String) As String
Dim aBytes() As Byte, varByte As Variant, b As Byte
aBytes = StrConv(vString, vbFromUnicode)
For Each varByte In aBytes
If varByte > 47 And varByte < 58 Then
AlphaNumericOnly = AlphaNumericOnly & Chr(varByte)
Else
b = varByte Or 32
If b > 96 And b < 123 Then AlphaNumericOnly =
AlphaNumericOnly & Chr(varByte)
End If
Next varByte
End Function

Private Function IsAValidIdentifier(strName As String) As Boolean
Dim pfValid As Long
If EbIsValidIdent(StrPtr(strName), pfValid) = 0 Then
IsAValidIdentifier = CBool(pfValid)
End Function

[BillCo]

>Even so, we do our best to help, so please don't hold it against us if we

can't provide the level of support you'd like.
awww, now i feel bad for being rude!! i should probably cut back on my
coffee intake.
Seriously, whenever i get good help either through reading old posts or
posting a question, I try to help out others by posting answers to
questions I can answer... so i'd hate you to think i'm an @ss who is
just out looking for free help and berating respondants for providing
silly answers.
many "nooks and crannies"

and you can double that for this project, which has all the continuity
of a plate of spagetti. Thinking I may just save myself the heartache
and [learn to_live with It]

I'll check out those links though, thanks all!

[BillCo]

that's some pretty nifty code lyle. slow, but quite thorough indeed.
cheers!

[Larry Linson]

"BillCo" <co**********@gmail.com> wrote

so i'd hate you to think i'm an @ss who is
just out looking for free help and berating
respondants for providing silly answers.

That wasn't what I was thinking about you. It is easy to get "wound up" in
the problem at hand, though, and not realize what we are asking others to
do. And, as for "silly answers," that's just a feature of newsgroups... I
give some silly ones, myself, at times.

many "nooks and crannies"

and you can double that for this project, which has all the continuity
of a plate of spagetti. Thinking I may just save myself the heartache
and [learn to_live with It]

I'll check out those links though, thanks all!

I've been tempted to do a "How'd they _do_ that" presentation for my user
group, showing some _examples_. But, given the very reasonable price of the
software that does the job well, I've not really been tempted to try to do
the same complete application!

Again, good luck with your project.

Larry Linson
Microsoft Access MVP