Forum des VBA-Tutorials

automatisches Ändern von VBA Scripten mit VBA (VBA)

Helmut W, Freitag, 17. März 2017, 15:25 (vor 11 Tagen) @ Helmut_W

Hallo zusammen,

ich habe eine Lösung, die für mich funktioniert.
Hier ist der entsprechende Code, der sicher noch verbesserungswürdig ist.
Für mich reicht es so.
Der Code zum Auswählen des Directories in dem alle Files bearbeitet werden sollen und das matchen der RegEx zur Auswahl der einzelnen Files ist hier nicht dabei.

Die fraglicher Zeile des VBA-Codes wird in allen VBA-Modulen aller Excel-Files eines Directories gesucht und modifiziert.

Aus:

 Set querydef = sessionObj.OAdSession.BuildQuery("ProblemReport")


wird:

 ' This line was replaced: Set querydef = sessionObj.OAdSession.BuildQuery("ProblemReport")
 Set querydef = sessionObj.OAdSession.BuildQuery("PR_CR")


...und hier ist der Code, der das macht:

Private Sub ReplaceStringVBA()
    On Error GoTo Oops
 
    Dim wb As Workbook
    Dim strPath As String
    Dim strFile As String
    Dim strToReplaceWith As String
    Dim strToReplace As String
    Dim i As Long
    Dim j As Long
    Dim strOldLine As String
    Dim strNewLine As String
    Dim VBE As Object
    Dim k  As Long
    Dim strK As String
    Dim BFF
 
    BFF = BrowseForFolder
    If BFF = False Then Exit Sub
    strPath = BFF & "\"
 
    strToReplaceWith = """PR_CR"""
    strToReplace = """ProblemReport"""
 
    strFile = Dir(strPath)
 
    k = 0
    While strFile <> ""
        'only use files that are not yet modified and which are excel files 
        If (Not matchRegex(strFile, "(^mod_.*xls)") And matchRegex(strFile, ".*xls")) Then
 
            Set wb = Workbooks.Open(strPath & strFile)
            wb.Activate
            Set VBE = ActiveWorkbook.VBProject
 
            If VBE.VBComponents.Item(1).Properties("HasPassword").value = False Then
                If VBE.VBComponents.Count > 0 Then
                    For i = 1 To VBE.VBComponents.Count
                        VBE.VBComponents.Item(i).Activate
                        If VBE.VBComponents.Item(i).CodeModule.CountOfLines > 0 Then
                            j = 1
                            Do
                              If InStr(1, VBE.VBComponents.Item(i).CodeModule.Lines(j, 1), strToReplace, vbTextCompare) Then
                                   k = k + 1
                                   strK = Right(Str(k), Len(Str(k) - 1))
                                   strOldLine = VBE.VBComponents.Item(i).CodeModule.Lines(j, 1)
                                   strNewLine = Replace(strOldLine, strToReplace, strToReplaceWith, 1, 1, vbTextCompare)
 
                                   'keep changed line as comment
                                   VBE.VBComponents.Item(i).CodeModule.ReplaceLine j, "' This line was replaced: " & strOldLine
                                   'add changed line
                                   VBE.VBComponents.Item(i).CodeModule.InsertLines j, strNewLine
                                   'since one line is added, increase line counter "j" by 1
                                   j = j + 1
                                End If
                                j = j + 1
                            'loop until all lines of code have been checked
                            Loop Until (j > VBE.VBComponents.Item(i).CodeModule.CountOfLines)
                        End If
                    Next i
                End If
            End If
            'save as new file "mod_..."
            wb.Close True, strPath & "mod_" & strFile
        End If
        strFile = Dir
    Wend
 
ContinueNext:
    Application.ScreenUpdating = True
    Exit Sub
Oops:
    MsgBox Err.Description
    Resume ContinueNext
End Sub

gesamter Thread:

 RSS-Feed dieser Diskussion

powered by my little forum