VBA Challenge how to code to loop through all files in folder and revise some part of the codes

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Select allOpen in new window

#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Select allOpen in new window

CAUTION: Many VBA-based computer viruses propagate themselves by creating and/or modifying VBA code. Therefore, many virus scanners may automatically and without warning or confirmation delete modules that reference the VBProject object, causing a permanent and irretrievable loss of code. Consult the documentation for your anti-virus software for details.

The VBIDE is the object library that defines all the objects and values that make up VBProject and the Visual Basic Editor. You must reference this library to use the VBA Extensibility objects. To add this reference, open the VBA editor, open your VBProject in the editor, and go to the Tools menu. There, choose References . In the References dialog, scroll down to Microsoft Visual Basic for Applications Extensibility 5.3 and check that item in the list. You can add the reference programmatically with code like:

    ThisWorkbook.VBProject.References.AddFromGuid GUID:="{0002E157-0000-0000-C000-000000000046}", Major:=5, Minor:=3

Option Explicit

Sub LoopThroughFiles(strPath As String)
    Dim strFile As String
    strFile = Dir(strPath & "*.xlsm")
    Do While Len(strFile) > 0
        ProcessFile strFile
        strFile = Dir
    Loop
End Sub

Sub ProcessFile(strFile As String)

    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    
    Set VBProj = Application.Workbooks(strFile).VBProject
    
    ' loop thru all VBE components
    For Each VBComp In VBProj.VBComponents
        ' if component is a code module
        If ComponentTypeToString(VBComp.Type) = "Code Module" Or ComponentTypeToString(VBComp.Type) = "Class Module" Then
            ' if the code module contains the desired API call
            If SearchCodeModule(VBProj, VBComp, Workbooks("template.xlsb").Sheets(1).Range("D1").Value) = True Then
                ' export the module to a text file
                Call ExportVBComponent(VBComp, Application.Workbooks(strFile).Path & "\", "temp.tmp")
                ' replace API call in exported file
                Call ReplaceStringInFile(Application.Workbooks(strFile).Path & "\temp.tmp", Workbooks("template.xlsb").Sheets(1).Range("D1").Value, Workbooks("template.xlsb").Sheets(1).Range("E1").Value)
                ' import fixed file
                VBProj.VBComponents.Import Application.Workbooks(strFile).Path & "\temp.tmp"
                ' save workbook
                Application.Workbooks(strFile).Save
                ' delete temp file
                Kill Application.Workbooks(strFile).Path & "\temp.tmp"
            End If
        End If
    Next VBComp

End Sub

Public Function ExportVBComponent(VBComp As VBIDE.VBComponent, _
        FolderName As String, _
        Optional FileName As String, _
        Optional OverwriteExisting As Boolean = True) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' This function exports the code module of a VBComponent to a text
    ' file. If FileName is missing, the code will be exported to
    ' a file with the same name as the VBComponent followed by the
    ' appropriate extension.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Extension As String
    Dim FName As String
    Extension = GetFileExtension(VBComp:=VBComp)
    If Trim(FileName) = vbNullString Then
        FName = VBComp.Name & Extension
    Else
        FName = FileName
        If InStr(1, FName, ".", vbBinaryCompare) = 0 Then
            FName = FName & Extension
        End If
    End If
    
    If StrComp(Right(FolderName, 1), "\", vbBinaryCompare) = 0 Then
        FName = FolderName & FName
    Else
        FName = FolderName & "\" & FName
    End If
    
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        If OverwriteExisting = True Then
            Kill FName
        Else
            ExportVBComponent = False
            Exit Function
        End If
    End If
    
    VBComp.Export FileName:=FName
    ExportVBComponent = True
    
End Function

Function SearchCodeModule(VBProject As VBIDE.VBProject, VBComp As VBIDE.VBComponent, strFind As String) As Boolean
    Dim CodeMod As VBIDE.CodeModule
    Dim FindWhat As String
    Dim SL As Long ' start line
    Dim EL As Long ' end line
    Dim SC As Long ' start column
    Dim EC As Long ' end column
    Dim Found As Boolean
    
    Set CodeMod = VBComp.CodeModule
    
    With CodeMod
        SL = 1
        EL = .CountOfLines
        SC = 1
        EC = 255
        Found = .Find(target:=strFind, StartLine:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, wholeword:=True, MatchCase:=False, patternsearch:=False)
        Do Until Found = False
            Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC)
            EL = .CountOfLines
            SC = EC + 1
            EC = 255
            Found = .Find(target:=strFind, StartLine:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, wholeword:=True, MatchCase:=False, patternsearch:=False)
        Loop
    End With
    SearchCodeModule = Found
End Function

Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String
    Select Case ComponentType
        Case vbext_ct_ActiveXDesigner
            ComponentTypeToString = "ActiveX Designer"
        Case vbext_ct_ClassModule
            ComponentTypeToString = "Class Module"
        Case vbext_ct_Document
            ComponentTypeToString = "Document Module"
        Case vbext_ct_MSForm
            ComponentTypeToString = "UserForm"
        Case vbext_ct_StdModule
            ComponentTypeToString = "Code Module"
        Case Else
            ComponentTypeToString = "Unknown Type: " & CStr(ComponentType)
    End Select
End Function

Public Function GetFileExtension(VBComp As VBIDE.VBComponent) As String
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   ' This returns the appropriate file extension based on the Type of
   ' the VBComponent.
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       Select Case VBComp.Type
           Case vbext_ct_ClassModule
               GetFileExtension = ".cls"
           Case vbext_ct_Document
               GetFileExtension = ".cls"
           Case vbext_ct_MSForm
               GetFileExtension = ".frm"
           Case vbext_ct_StdModule
               GetFileExtension = ".bas"
           Case Else
               GetFileExtension = ".bas"
       End Select
       
   End Function
    
Sub ReplaceStringInFile(strFileName As String, strFind As String, strReplace As String)
    
    Dim strBuf As String
    Dim strTemp As String
    Dim intFileNum As Integer
    
    intFileNum = FreeFile
    Open strFileName For Input As intFileNum
    
    Do Until EOF(intFileNum)
        Line Input #intFileNum, strBuf
        strTemp = strTemp & strBuf & vbCrLf
    Loop
    Close intFileNum
    
    strTemp = Replace(strTemp, strFind, strReplace)
    
    intFileNum = FreeFile
    Open strFileName For Output As intFileNum
    Print #intFileNum, strTemp
    Close intFileNum
    
End Sub

Select allOpen in new window

Sub Main()
LoopThroughFiles (Sheets(1).Cells(2, 1).Value)
End Sub

Select allOpen in new window