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

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

在将来打开新工作簿的某个时间，会在子文件夹中创build工作簿的修订版本和新版本（带有修订名称）。 冲洗并重复。 这是上帝可怕的。

这些自我复制的borg excel电子表格容易存在。 最大的摩擦？ 在macros中根path的硬编码path。 现在，根文件夹必须移动。

我自己并不是一个优秀的用户，但我需要解决这个问题。 有什么我可以写在.net（或其他任何东西）走根和子文件夹，并更新每个Excel文件它发现改变path？ 当然，没有损害每个电子表格中的数据？

任何帮助赞赏。

---

编辑:(所以你不需要我的意见）下面的解决scheme@ 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已经提出了这个可能的解决scheme 。

编辑2：VBA项目密码解决scheme的作品！ 我还将@brettdj代码示例移动到vb.net项目中，现在可以遍历超过400k的所有文件，检查是否需要密码，如果解锁，则search代码以find违规行，如果find，则replace它，然后保存，如果修改。 总的来说，酷豆。

Answer 1

VBA解决scheme

1. 这段代码在由strStartFolder = "c:\temp"设置的文件夹上运行recursion目录
2. 它打开所有Excel文件，然后使用Pearson的方法来识别和replace四种代码模块types中的某个string：
   "c:\temp\xxx"
   同
   "d:\temp\yyy"
3. 代码然后保存调整的工作簿（但只是closures未改变的工作簿）
4. 然后提供给用户的所做更改的摘要文件

编码VBE的一个特点是在这里使用一个stringvariables失败：
bFound = .Find(strOld, SL, SC, EL, EC, True, False, False)
我不得不硬编码string来代替
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