简体   繁体   中英

Text replace in VBA code of Excel files

we have several tens of macro enabled excel files, each of those contains few VBA modules and in each of those modules there are SQL server names and userid/passwords of the sql login.

I wonder if I could write some kind of C# utility which loads those files one by one and either with .NET-Office Interop. or any other approach replace those strings with something else... just because I have to repoint all those VBA macros to another server name and to use another sql login name and password... I really wouldn't like to do this replacement by hand:(:(:(

thanks!

To begin With

Sorry for taking some time in posting but I was creating a UI for it so that it not only helps you but anyone else who comes looking for the same functionality.

You need to first enable Trust Access to the VBA project Object model

Open Excel and Click on File Tab | Options | Trust Center | Trust Center Settings | Macro Settings

Enable macro and click on Trust access to Visual Basic projects

在此处输入图像描述

Next In VBA Editor

Click on Tool | Options and under the "Editor" Tab select the checkbox Require Variable Declaration

在此处输入图像描述

Next Download the Sample file from here and simply press the Run Button In Sheet1 to launch the userform as shown below.

Simple select the folder which has ONLY Excel Files. Enter the relevant info and click on Start Replace and you are done:)

在此处输入图像描述

Code Used

Sheet1 Code Area

Option Explicit

Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

Userform Code Area

Option Explicit

Private Sub CommandButton1_Click()
    Dim Ret
    Ret = BrowseForFolder
    If Ret = False Then Exit Sub
    TextBox1.Text = Ret
End Sub

Private Sub CommandButton3_Click()
    On Error GoTo Whoa

    Dim wb As Workbook
    Dim strPath As String, strfile As String
    Dim strToReplaceWith As String, strToReplace As String
    Dim i As Long, j As Long

    Dim VBE As Object

    strPath = TextBox1.Text & "\"

    strfile = Dir(strPath)

    While strfile <> ""
        Set wb = Workbooks.Open(strPath & strfile)

        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.VBE.CodePanes.Item(i).CodeModule.CountOfLines > 0 Then
                        For j = 1 To VBE.VBE.CodePanes.Item(i).CodeModule.CountOfLines
                            If InStr(1, VBE.VBE.CodePanes.Item(i).CodeModule.Lines(j, 1), TextBox2.Text, vbTextCompare) Then
                                strToReplace = VBE.VBE.CodePanes.Item(i).CodeModule.Lines(j, 1)
                                strToReplaceWith = Replace(strToReplace, TextBox2.Text, TextBox3.Text, 1, 1, vbTextCompare)
                                VBE.VBE.CodePanes.Item(i).CodeModule.ReplaceLine j, strToReplaceWith
                            End If
                        Next
                    End If
                Next i
            End If
        End If

        wb.Close True

        strfile = Dir
    Wend

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function to pop the browse folder dialog
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object

    '~~> Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    '~~> Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    '~~> Destroy the Shell Application
    Set ShellApp = Nothing

    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
    BrowseForFolder = False
End Function

Private Sub CommandButton4_Click()
    Unload Me
End Sub

MORE SNAPSHOTS

在此处输入图像描述

File Whose code needs to be replaced before the macro is Run

在此处输入图像描述

After the macro is run

在此处输入图像描述

EDIT

ALTERNATIVE FILE DOWNLOAD LOCATION

In case the above wikisend link dies, the file can be downloaded from here

I suggest you create a config file which includes your server names and credentials. Then you add a module to each of your Excel files that parses this config file at startup and fills global variables with it. You just have to adjust the variables for the server name etc. in all your VBA modules to the new global variables.

This way you can change your access data any time you like just by editing or replacing the text file.

I propose this way of solving your problem. You can create separate vba or vbscript project which will load all the spreadsheets one by one, exporting contents of their vba projects to separate text files. Then you can load those text files and perform string replacements. Afterwards, you can import text files back to spreadsheet as a vba project components (by simple reverting of export process).

You can use this code like this one for exporting the components:

Public Sub ExportAppSrcs(targetWb as Workbook)
Dim wb As Workbook, Component As Object, Suffix As String, fileName As String

Set wb = targetWb
    For Each Component In wb.VBProject.VBComponents

        Select Case Component.Type
            Case 1                  'modul
                Suffix = ".bas"
            Case 2                  'class modul
                Suffix = ".cls"
            Case 3                  'form
                Suffix = ".frm"
            Case 100                'dokument
                Suffix = ".xwk"
            Case Else
                Suffix = ""
        End Select

        If Suffix <> "" Then
            On Error Resume Next
            fileName = wb.Path & "\spreadsheet.xlsm.src\" & Component.name & Suffix
            Component.Export fileName
        End If
    Next 
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM