Joss, спасибо за сслочку
Всё же я поделюсь кое-чем, если кому-то понадобится переименовать таблицы только в связанной базе данных с целью их совместимости с MySQL, например. Переименованные таблицы прилинковываются к основной БД, а к ним старые русские запросы ))))
При этом не нужно ничего поправлять в коде программы
Option Compare Database
Option Explicit
Dim db2 As New Access.Application
Dim rst As Recordset
Private Sub Выполнить_все_шаги_для_переименования_связанных_таблиц()
DoCmd.Echo 0
Set rst = CurrentDb.OpenRecordset("Rename")
DoCmd.RunSQL ("UPDATE Rename SET new = Replace(LCase([new]),' ','_')")
Переименование_таблиц_по_списку
Замены_в_связанных_полях_БД2
Перезалить_прилинкованные_таблицы
Создать_запросы
Set db2 = Nothing
Set rst = Nothing
DoCmd.Echo 1
MsgBox "Done!"
End Sub
Private Sub Переименование_таблиц_по_списку()
db2.OpenCurrentDatabase (полное_имя_файла_с_данными)
On Error Resume Next
rst.MoveFirst
Do Until rst.EOF
If rst!old <> rst.Name Then
db2.Application.DoCmd.Rename rst!New, acTable, rst!old
DoCmd.Rename rst!New, acTable, rst!old
End If
rst.MoveNext
Loop
On Error GoTo 0
End Sub
Private Function после_замен(ByRef старая As String) As String
rst.MoveFirst
While Not rst.EOF
старая = Replace(старая, "[" & rst!old & "].", "[" & rst!New & "].")
старая = Replace(старая, " " & rst!old & ".", " " & rst!New & ".")
старая = Replace(старая, "FROM [" & rst!old & "] ", "FROM [" & rst!New & "] ")
старая = Replace(старая, "FROM " & rst!old & " ", "FROM " & rst!New & " ")
старая = Replace(старая, "FROM " & rst!old & ";", "FROM " & rst!New & ";")
старая = Replace(старая, "(" & rst!old & ".", "(" & rst!New & ".")
rst.MoveNext
Wend
после_замен = старая
End Function
Private Sub Замены_в_связанных_полях_БД2()
Dim t As TableDef
Dim f As Field
Dim p As String
On Error Resume Next
For Each t In db2.Application.CurrentDb.TableDefs
If Not t.Name Like "~*" And Not t.Name Like "msys*" Then
For Each f In t.Fields
f.Properties("RowSource") = после_замен(f.Properties("RowSource"))
Next f
End If
Next
On Error GoTo 0
End Sub
Public Sub Перезалить_прилинкованные_таблицы()
Dim dbs As Object
Dim tdf As Object
Dim s As String
s = полное_имя_файла_с_данными
'ссылка на БД
Set dbs = CurrentDb
'для каждой таблицы
For Each tdf In dbs.TableDefs
'если таблица из внешней БД
If tdf.SourceTableName <> "" Then
Таблицы.Удалить tdf.Name
DoCmd.TransferDatabase acLink, "Microsoft Access", s, acTable, tdf.Name, tdf.Name
End If
Next tdf
'следы
Set tdf = Nothing
Set dbs = Nothing
End Sub
Private Sub Создать_запросы()
On Error Resume Next
rst.MoveFirst
Do Until rst.EOF
If rst!old <> rst.Name Then
Создать_запрос rst!old, "Select * From [" & rst!New & "]"
End If
rst.MoveNext
Loop
On Error GoTo 0
End Sub
