Question

我有一个包含6个子文件夹和~300个excel工作簿的目录（每天都在增长）。每个工作簿都有多个公式（每个工作簿大约1200个），它们引用存储在服务器路径上的CSV数据转储。

我的问题是excel将CSV数据转储视为“脏数据”，并在每次打开工作簿时提示警告声称无法更新链接（但是当检查链接时，excel表示没有问题）。在我的所有研究中，我发现似乎没有办法解决这个问题，除了用.xsl文件替换数据源，而excel没有引用任何问题。

我需要做的是，在~300个工作簿上执行查找和替换，找到公式中的CSV服务器路径，并将其替换为.xls文件的新服务器路径。

我尝试过“Sobolsoft的Excel查找和替换”软件，但似乎并不想在公式内部进行替换。我曾经使用过“Easy-XL”和“Kutools”，它们只适用于打开的工作簿（我可以忍受，如果我一次只能打开20-50个工作簿，运行查找和替换，然后打开下一批）但他们都不想工作。

我使用以下宏取消保护/保护完美运行的目录中的每个工作簿

Const cStartFolder = "M:\Transfer\DrillHole_Interaction\4.For_Survey" 'no slash at end
Const cFileFilter = "*.xlsm"
Const cPassword = "" 'use empty quotes if blank

Sub UnprotectAllWorksheets()
Dim i As Long, j As Long, arr() As String, wkb As Workbook, wks As Worksheet

ExtractFolder cStartFolder, arr()

On Error Resume Next
j = -1: j = UBound(arr)
On Error GoTo 0

For i = 0 To j
    Set wkb = Workbooks.Open(arr(i), False)
    For Each wks In wkb.Worksheets
        wks.Protect cPassword, True, True
    Next
    wkb.Save
    wkb.Close
Next
End Sub

Sub ExtractFolder(Folder As String, arr() As String)
Dim i As Long, objFS As Object, objFolder As Object, obj As Object

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(Folder)

For Each obj In objFolder.SubFolders
    ExtractFolder obj.Path, arr()
Next

For Each obj In objFolder.Files
    If obj.Name Like cFileFilter Then
        On Error Resume Next
        i = 0: i = UBound(arr) + 1
        On Error GoTo 0
        ReDim Preserve arr(i)
        arr(i) = objFolder.Path & Application.PathSeparator & obj.Name
    End If
Next
End Sub

如果它会有所帮助，我也愿意从'Master'工作簿中复制并将特定范围复制到彼此的工作簿中（复制范围到每本书的范围）但是我在我的智慧结束而不是知道如何继续。任何帮助将不胜感激。

Answer 1

无需在所有公式中查找和替换csv fullname（路径和文件名），只需在每个工作簿中立即更改链接源。

在循环中尝试使用所有需要更改的工作簿。

Dim Wbk As Workbook

    Application.DisplayAlerts = False
    Set Wbk = Workbooks.Open(Filename:="WbkTarget.Fullname", UpdateLinks:=3)
    With Wbk
        .ChangeLink _
            Name:="CsvFile.Fullname", _
            NewName:="XlsFile.Fullname", _
            Type:=xlExcelLinks
        .Save
        .Close
    End With
    Application.DisplayAlerts = True

其中：

WbkTarget.Fullname ：包含要替换的链接的工作簿的路径和名称

CsvFile.Fullname ：要替换的csv文件的路径和名称

XlsFile.Fullname ：替换csv文件的xls的路径和名称

在多个excel工作簿中查找并替换公式中的特定字符串

1 个答案: