Thursday, May 26, 2005

HOW TO: Use Sample Automation Code to Transfer Tables to a Secured Access 2002 .mdb File a microsoft support page this enbabled me to loop through the tables in new database

Wednesday, May 25, 2005

Mozilla Firefox Start Pagebelow is the text>>>>>>>>>>>>>>>>>>>>>
Option Compare Database


Public Sub fncChangeTableNames()
On Error GoTo err_fncChangeTableNames
Dim MyDB As Database, MyRS As Recordset, MyTDef As TableDef, myTDefs As TableDefs, MyField As Field, myFields As Fields

Set MyDB = CurrentDb()

Set myTDefs = MyDB.TableDefs
For Each MyTDef In myTDefs
If InStr(1, MyTDef.Name, "tbl") > 0 Then
Set myFields = MyTDef.Fields

For Each MyField In myFields

MyField.Name = EditObjectName(MyField.Name)
myFields.Refresh
'MsgBox EditObjectName(MyField.Name)
Next
End If
Next
MsgBox "done"
Exit Sub
err_fncChangeTableNames:
Resume Next

End Sub
Function EditObjectName(ByVal ObjectName As String) As String

Dim MyAsc As Integer
Dim MyAscPrev As Integer
Dim MyAscNext As Integer
Dim SkipInsert As Integer
Dim ObjectLength As Integer

On Error GoTo Error_EditObjectName

I = 1
Do Until (Asc(Mid$(ObjectName, I, 1)) >= 65 And Asc(Mid$(ObjectName, I, 1)) <= 90) Or I > Len(ObjectName)
I = I + 1
Loop
If I > Len(ObjectName) Then
EditObjectName = ObjectName
Else
SkipInsert = 0
ObjectName = Right$(ObjectName, Len(ObjectName) - I + 1)
ObjectLength = Len(ObjectName)
For I = 2 To ObjectLength
MyAsc = Asc(Mid$(ObjectName, I, 1))
MyAscPrev = Asc(Mid$(ObjectName, I, 1))
If I < ObjectLength Then
MyAscNext = Asc(Mid$(ObjectName, I, 1))
End If
If MyAsc = 32 Then
'If MyAsc >= 65 And MyAsc <= 90 Then

'If Not (((MyAscNext >= 65 And MyAscNext <= 90) And (MyAscPrev >= 65 And MyAscPrev <= 90)) Or MyAscPrev = 32) Then
ObjectName = Left$(ObjectName, I - 1) & "_" & Right$(ObjectName, Len(ObjectName) - I)
'ObjectName = Left$(ObjectName, I + SkipInsert - 1) & "_" & Right$(ObjectName, Len(ObjectName) - I - SkipInsert + 1)
SkipInsert = SkipInsert + 1
'End If
End If
'If MyAsc = 95 Then
' ObjectName = Left$(ObjectName, I + SkipInsert - 1) & " " & Right$(ObjectName, Len(ObjectName) - I - SkipInsert)
'End If
Next I
EditObjectName = ObjectName
End If

Exit Function

Error_EditObjectName:
DoCmd.Echo True
DoCmd.Hourglass False
DoCmd.Beep
MsgBox Error$, 48, "Microsoft Access Error"
Exit Function

End Function

<<<<