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

Good Afternoon.

our IT team has changed the Office programs from 32bit of Excel to 64bit, now our finance department has a lot of files with macros in them, like around 598 of those files have codes that use the window API by using the Declare statement.
i would need to convert a bunch of 32bit API calls in these files to 64bit compliant calls while preserving 32bit compatibility as well.

i created the attached template. where i can put the directory, then file names and then two box for searching code and replacing it with code.

so, ideally , the code to loop through all files in the referred directory and its subfolders and if the files listed in Column C found then initiate search on those files by finding the codes listed in column D and replace them with code in column E.

i search the whole day and i could not find anything or any help on google or in any other forum, which brings me here to EE VBA gurus and i am hoping someone would be able to help me here.

thank you in advance.
2017-02-14-12_49_34-template.xlsb---.pngtemplate.xlsb
MikeYoungMoonAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Joe HowardCommented:
Which API calls do need to be adapted?
btw, it is recommended to use conditional compilation so the same code will work on both platforms.
MikeYoungMoonAuthor Commented:
thank you MacroShadow,

please see attached file which i uploaded in my original post.

it is a conditional compilation, so it will work in both platforms

for example
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

Open in new window


to be replaced by
#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

Open in new window

Joe HowardCommented:
Wow, I like this challenge.

The following code is based on Chip Pearson's code. This is his warning:
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.

To use the following code you must add a reference to the VBIDE library:
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

Now for the code:
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

Open in new window


Note: I have not tested the code.
Get Blueprints for Increased Customer Retention

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

MikeYoungMoonAuthor Commented:
@MacroShadow

phew!  that is really something.  very much appreciated.

i created a new folder to and place it in my download folder so the path to feed into procedure LoopThroughFiles  C:\Users\Mikael\Downloads\New folder\
Sub Main()
LoopThroughFiles (Sheets(1).Cells(2, 1).Value)
End Sub

Open in new window


then i place the file Split Data Based on Column Value.xlsm in the new folder for testing, it has the code of the 32bit and then i ran the code, then i ran into error Subscript out of range  in line  Set VBProj = Application.Workbooks(strFile).VBProject of Sub ProcessFile(strFile As String)

i have attached the template which has the code in it, the sample file for which the code need to be replaced which was in my New Folder .

i am not sure what is really causing it, i tried debugging it, but after many tries, i think i am after a goose chase without having the extensive knowledge of VBA. grateful if you could please help.
Split-Data-Based-on-Column-Value.xlsm
Main-Template.xlsb
Joe HowardCommented:
What is the value of strFile at time of the error in line  Set VBProj = Application.Workbooks(strFile).VBProject of Sub ProcessFile(strFile As String)?
Bill PrewIT / Software Engineering ConsultantCommented:
I did something like this in a VBS script to update Access MDB code.  It might be adaptable without too much trouble, I'll take a look.

Are any of the Excel files that need to be updated going to have protection on them, that could be a problem for those?

Also, can you upload a sample Excel file with the code in it for testing?

Will the existing definitions match what you are expecting 100%, including capitalization, spaces, linefeeds, etc?  Naturally if different files have slightly different formats then that will be a problem.

Just a thought, it might make sense to comment out the existing line and add the updated line after it, for future reference...

~bp
MikeYoungMoonAuthor Commented:
@MacroShadow,
when i hover over it, it shows the file name, i posted screenshot.
2017-02-14-18_14_53-Microsoft-Visual.png

@Bill,
none of the file has any protection.
Joe HowardCommented:
You have to pass the full path, not only the file name.
MikeYoungMoonAuthor Commented:
I passed full path and it resulted the same error.
Joe HowardCommented:
Perhaps the file has to be open. I'm just guessing as I don't have time right now to investigate further.
Bill PrewIT / Software Engineering ConsultantCommented:
Yes, looking at the code quickly that would require that the workbook needed to be open in Excel before this code executes.

~bp
MikeYoungMoonAuthor Commented:
excuse my ignorance, do i need to manually open each workbook and run the code?
Bill PrewIT / Software Engineering ConsultantCommented:
As it stands I believe so.  Or the code could be altered to include opening of the workbook, and then closing it.

~bp
Joe HowardCommented:
Try this updated code, the workbook opening is managed by the code, additionally there was a typo (D1 instead of D2).
Note that the spaces, line breaks ect. in both the modules and in the template.xlsb should match (currently they do not).
Option Explicit

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

Sub ProcessFile(strFile As String)

    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim wb As Workbook

    wb = Workbooks.Open(strFile)
    Set VBProj = wb.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("D2").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("D2").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
    
    wb.Close
    Set wb = Nothing
    
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

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
MikeYoungMoonAuthor Commented:
thanks MacroShadow.

unfortunately, i could not get it worked. the first error it threw was in Sub Routine Sub ProcessFile(strFile As String) line  wb = Workbooks.Open(strFile)  ERROR was  "Runtime Error 91: Object variable or with block variable not set"

so, i put Set in front of it and the error went away.


now, no matter what, the boolean of Found = .Find(target:=strFind, StartLine:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, wholeword:=True, MatchCase:=False, patternsearch:=False)  is always false.
i used the Debug.Print Len(strFind) returned the exact same length of the D2 cell.

i tried it with just a single word and multiple words. did not work.

perhaps, i am asking here too much. you already spent time on this and i appreciate it very much. so i will try to keep debugging to find the problem. thanks alot
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.