如何更新数百个 excel 文件中的宏？

Question

我们有一个共享文件夹，用户在其中打开一个 Excel 工作簿，填写数据，然后运行一个宏来创建一个子文件夹并将工作簿的一个版本复制到该文件夹​​中。子文件夹和新工作簿是根据输入到表单中的数据命名的。

将来某个时候打开新工作簿，进行修订并在子文件夹中创建工作簿的新版本（带有修订名称）。冲洗并重复。太可怕了。

这些自我复制的 borg excel 电子表格很容易存在一千个。最大的摩擦？宏中根路径的硬编码路径。现在必须移动根文件夹。

我自己不是excel用户，但我需要解决这个问题。有什么我可以在.Net（或其他任何东西）中编写的东西来遍历根和子文件夹，并更新它找到的每个 Excel 文件以更改路径？当然不会损害每个电子表格中的数据？！

任何帮助表示赞赏。

---

编辑：（所以你不需要挖掘 cmets） @brettdj 的以下解决方案开箱即用。对于我的情况，我确实将其移出Sub Main()，我需要从他的示例中更改以下行：

bFound = .Find("C:\test\xxx", SL, SC, EL, EC, True, False, False)

到

bFound = .Find("C:\test\xxx", SL, SC, EL, EC, False, False, False)

我相信这会将查找更改为不匹配整个单词。

我还有一个 VBA 项目受密码保护的问题，我目前尚未解决，但 @brettdj 建议 this possible solution。

编辑 2：VBA 项目密码解决方案有效！我还将@brettdj 代码示例移到vb.net 项目中，现在对超过400k 的所有文件进行循环，检查是否需要密码，如果需要则解锁，在代码中搜索有问题的行，如果找到则替换它，如果修改则保存。总的来说，很酷的豆子。

Answer 1

VBA 解决方案

1. 此代码在strStartFolder = "c:\temp" 设置的文件夹上运行recursive Dir
2. 它打开所有Excel文件，然后使用Pearson's method来识别和替换四种代码模块类型中的某个字符串：
   "c:\temp\xxx"
   与
   "d:\temp\yyy"
3. 代码然后保存调整后的工作簿（但只是关闭未更改的工作簿）
4. 然后将所做更改的摘要文件提供给用户

对 VBE 进行编码的一个特点是在此处使用字符串变量失败：
bFound = .Find(strOld, SL, SC, EL, EC, True, False, False)
我不得不硬编码要替换的字符串
bFound = .Find("c:\temp\xxx", SL, SC, EL, EC, True, False, False)

 Option Explicit

Public StrArray()
Public lngCnt As Long

Public Sub Main()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim WB As Workbook
    Dim ws As Worksheet
    Dim strStartFolder As String

     'Setup Application for the user
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

     'reset public variables
    lngCnt = 0
    ReDim StrArray(1 To 4, 1 To 1000)

    strStartFolder = "c:\temp"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strStartFolder)

     ' Format output sheet
    Set WB = Workbooks.Add(1)
    Set ws = WB.Worksheets(1)
    ws.[a1] = Now()
    ws.[a2] = strStartFolder
    ws.[a1:a3].HorizontalAlignment = xlLeft

    ws.[A4:D4].Value = Array("Folder", "File", "Code Module", "line")
    ws.Range([a1], [c4]).Font.Bold = True
    ws.Rows(5).Select
    ActiveWindow.FreezePanes = True


     ' Start the code to gather the files
    ShowSubFolders objFolder, True
    ShowSubFolders objFolder, False

    If lngCnt > 0 Then
         ' Finalise output
        With ws.Range(ws.[a5], ws.Cells(5 + lngCnt - 1, 4))
            .Value2 = Application.Transpose(StrArray)
            .Offset(-1, 0).Resize(Rows.Count - 3, 4).AutoFilter
            .Offset(-4, 0).Resize(Rows.Count, 4).Columns.AutoFit
        End With
        ws.[a1].Activate
    Else
        MsgBox "No files found!", vbCritical
        WB.Close False
    End If

     ' tidy up

    Set objFSO = Nothing

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .StatusBar = vbNullString
    End With
End Sub


Sub ShowSubFolders(ByVal objFolder, bRootFolder As Boolean)

    Dim colFolders As Object
    Dim objSubfolder As Object
    Dim WB As Workbook
    Dim strOld As String
    Dim strNew As String
    Dim strFname As String

    Dim VBProj As Object
    Dim VBComp As Object
    Dim CodeMod As Object
    Dim bFound As Boolean
    Dim bWBFound As Boolean

    Dim SL As Long
    Dim SC As Long
    Dim EL As Long
    Dim EC As Long
    Dim S As String


    strOld = "c:\temp\xxx"
    strNew = "D:\temp\yyy"

    Set colFolders = objFolder.SubFolders
    Application.StatusBar = "Processing " & objFolder.Path

    If bRootFolder Then
        Set objSubfolder = objFolder
        GoTo OneTimeRoot
    End If

    For Each objSubfolder In colFolders
         'check to see if root directory files are to be processed
OneTimeRoot:
        strFname = Dir(objSubfolder.Path & "\*.xls*")
        Do While Len(strFname) > 0
            Set WB = Workbooks.Open(objSubfolder.Path & "\" & strFname, False)
            Set VBProj = WB.VBProject
            For Each VBComp In VBProj.vbcomponents
                    Set CodeMod = VBComp.CodeModule
                    With CodeMod
                        SL = 1
                        EL = .CountOfLines
                        SC = 1
                        EC = 255
                        bFound = .Find("C:\test\xxx", SL, SC, EL, EC, True, False, False)
                         'bFound = .Find(strOld, SL, SC, EL, EC, True, False, False)
                        If bFound Then bWBFound = True
                        Do Until bFound = False
                            lngCnt = lngCnt + 1
                            If UBound(StrArray, 2) Mod 1000 = 0 Then ReDim Preserve StrArray(1 To 4, 1 To UBound(StrArray, 2) + 1000)
                            StrArray(1, lngCnt) = objSubfolder.Path
                            StrArray(2, lngCnt) = WB.Name
                            StrArray(3, lngCnt) = CodeMod.Name
                            StrArray(4, lngCnt) = SL
                            EL = .CountOfLines
                            SC = EC + 1
                            EC = 255
                            S = .Lines(SL, 1)
                            S = Replace(S, "C:\test\xxx", "D:\test\yyy")
                            .ReplaceLine SL, S
                            bFound = .Find("C:\test\xxx", SL, SC, EL, EC, True, False, False)
                        Loop
                    End With
            Next
            If bWBFound Then WB.Save
            WB.Close False
            strFname = Dir
        Loop
        If bRootFolder Then
            bRootFolder = False
            Exit Sub
        End If
        ShowSubFolders objSubfolder, False
    Next
End Sub