Option Compare Database
Option Explicit
Public Sub test()
FRDB "d:\~home~\desktop\db1.mdb", "172.20.1.7", "11.111.11.1"
FRDB "d:\~home~\desktop\db1.mdb", "172.20.1.7", "11.111.11.1"
MsgBox "Усе"
End Sub
Public Function FRDB(MdbFullName As String, MyServerOld As String, MyServerNew As String)
Dim cmd As String
Dim App As Access.Application
cmd = """" & SysCmd(acSysCmdAccessDir) & "msaccess.exe"""
cmd = cmd & " """ & MdbFullName & """"
Shell cmd, vbHide
Set App = GetObject(MdbFullName)
AllProcsFindAndReplace App, MyServerOld, MyServerNew
App.Quit
End Function
Public Function AllProcsFindAndReplace(ByRef App As Access.Application, MyServerOld As String, MyServerNew As String)
Dim oVBComponent As Object, mdl As Object
For Each oVBComponent In App.VBE.ActiveVBProject.VBComponents
Set mdl = oVBComponent.CodeModule
FindAndReplace App, mdl.Name, MyServerOld, MyServerNew
Next
End Function
Function FindAndReplace(App As Access.Application, strModuleName As String, strSearchText As String, strNewText As String) As Boolean
Dim mdl As Module
Dim lngSLine As Long, lngSCol As Long
Dim lngELine As Long, lngECol As Long
Dim strLine As String, strNewLine As String
Dim intChr As Integer, intBefore As Integer, intAfter As Integer
Dim strLeft As String, strRight As String
' Open module.
App.DoCmd.OpenModule strModuleName
' Return reference to Module object.
Set mdl = App.Modules(strModuleName)
' Search for string.
If mdl.Find(strSearchText, lngSLine, lngSCol, lngELine, _
lngECol) Then
' Store text of line containing string.
strLine = mdl.Lines(lngSLine, Abs(lngELine - lngSLine) + 1)
' Determine length of line.
intChr = Len(strLine)
' Determine number of characters preceding search text.
intBefore = lngSCol - 1
' Determine number of characters following search text.
intAfter = intChr - CInt(lngECol - 1)
' Store characters to left of search text.
strLeft = Left$(strLine, intBefore)
' Store characters to right of search text.
strRight = Right$(strLine, intAfter)
' Construct string with replacement text.
strNewLine = strLeft & strNewText & strRight
' Replace original line.
mdl.ReplaceLine lngSLine, strNewLine
FindAndReplace = True
Else
'MsgBox "Text not found."
FindAndReplace = False
End If
Exit_FindAndReplace:
Exit Function
Error_FindAndReplace:
MsgBox Err & ": " & Err.Description
FindAndReplace = False
Resume Exit_FindAndReplace
End Function
|