All,
I am migrating from Access to SQL Server. At the moment there are a lot of Excels connected to the Access DB with ADO. They are not all equal so replacing modules is not possible.
I try to find and replace the connection via an VBA script below.
I now have issues replacing strings that already have quotes inside to reference to another declared variable.
For example replace the VBA string
"Data Source= " & Path & Filename
to
"Data Source= " & Data_source & "Initial Catalog= " & Initial_catalog
I was thinking to replace the quotes in the string first with @ and then back again to ", but this is not possible for the FIND WHAT as you can see below and not really efficient. I define the Data source and initial catalog in another macro.
Hope somebody can help.
The complete code I have now:
Sub ReplaceTextInCodeModules()
' Must add a reference to "Microsoft Visual Basic For Applications Extensibility 5.3"
' Also must set "Trust access to the VBA project object model"
' See the url below for more info on these.
' Based on code found at:
' Source: www.cpearson.com/excel/vbe.aspx Copyright 2013, Charles H. Pearson
Dim theWorkbook As Workbook
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim numLines As Long ' end line
Dim lineNum As Long
Dim thisLine As String
Dim message As String
Dim numFound As Long
Const FIND_WHAT1 As String = "Provider=Microsoft.ACE.OLEDB.12.0; "
Const REPLACE_WITH1 As String = "Provider=SQLOLEDB;"
Const FIND_WHAT2 As String = "@Data Source= @ & Path & filename & @;@"
Const REPLACE_WITH2 As String = "@Data Source= @ & Data_source & @ Initial Catalog= @ & Initial_catalog & @ Integrated Security=SSPI; @"
numFound = 0
For Each theWorkbook In Application.Workbooks
If theWorkbook.Name <> ThisWorkbook.Name Then
If theWorkbook.HasVBProject Then
Set VBProj = theWorkbook.VBProject
For Each VBComp In VBProj.VBComponents
'Set VBComp = VBProj.VBComponents("Module1")
Set CodeMod = VBComp.CodeModule
With CodeMod
numLines = .CountOfLines
For lineNum = 1 To numLines
thisLine = .Lines(lineNum, 1)
If InStr(1, thisLine, FIND_WHAT1, vbTextCompare) > 0 Then
message = message & theWorkbook.Name & " | " & VBComp.Name & " | Line #" & lineNum & vbNewLine
.ReplaceLine lineNum, Replace(thisLine, FIND_WHAT1, REPLACE_WITH1, , , vbTextCompare)
numFound = numFound + 1
End If
If InStr(1, thisLine, FIND_WHAT2, vbTextCompare) > 0 Then
message = message & theWorkbook.Name & " | " & VBComp.Name & " | Line #" & lineNum & vbNewLine
.ReplaceLine lineNum, Replace(thisLine, FIND_WHAT2, REPLACE_WITH2, , , vbTextCompare)
numFound = numFound + 1
End If
Next lineNum
End With
Next VBComp
End If
End If
Next theWorkbook
Debug.Print "Found: " & numFound
If message <> "" Then
Debug.Print message
End If
If numFound = 0 Then
MsgBox ("Nothing found to replace.")
Else
MsgBox ("Paths replaced!" & vbNewLine & message)
End If
End Sub
question from:
https://stackoverflow.com/questions/66051426/replace-vba-with-macro-with-quotes 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…