如何更新數百個excel文件中的宏？

Question

我們在工作中有一個共享文件夾，用戶打開一個excel工作簿，填寫數據，然後運行一個宏來創建一個子文件夾並將該工作簿的一個版本複製到該文件夾​​中。子文件夾和新工作簿是根據輸入到表單中的數據命名的。

在將來打開新工作簿的某個時間，會在子文件夾中創建修訂版本和新版本的工作簿（帶有修訂名稱）。沖洗並重復。這太糟糕了。

這些自我複製的borg excel電子表格很容易存在。最大的擦傷？在宏中根路徑的硬編碼路徑。現在，該根文件夾必須移動。

我不是一個優秀的用戶我自己，但我需要解決這個問題。有什麼我可以在.Net（或其他任何東西）可以寫根子&子文件夾，並更新它找到的每個Excel文件來更改路徑？當然，不會損害每個電子表格中的數據？！

任何幫助表示讚賞。

---

編輯：（所以你不需要開採評論） 通過@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"
2. 它打開所有的Excel文件，然後使用Pearson's method在四個代碼來識別並替換某些字符串設定的文件夾上recursive Dir -module類型：
   "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