Question

前提性：

我有一个带有很多{LINKS ...}的word文档到excel文档，以便更容易生成word文档。当我将这些文档移动到新目录时，我想用新目录更新所有链接，也可能更新新的Excel文档名称。

问题：

我在stackoverflow和其他网站上发现了一个主要完成我需要的vba /宏。当我执行通配符.find .replace时，问题就出现了，其中替换文本包含\并且dirname包含数字。

代码：

Public Sub planer_fix_data_link()
    Dim rngStory As Word.Range
    Dim pFindTxt As String
    Dim pReplaceTxt As String
    Dim lngJunk As Long
    Dim oShp As Shape

    'Pattern to find with wildcards as i don't always know the last location
    pFindTxt = "LINK Excel.Sheet.12*xlsx"


TryAgain:
        pReplaceTxt = InputBox("New excel filename", "Malldata filnamn")

        If pReplaceTxt = "" Then
            If MsgBox("Do you just want to delete the found text?", vbYesNoCancel) = vbNo Then
                GoTo TryAgain
            ElseIf vbCancel Then
                MsgBox "Cancelled by User."
            Exit Sub
        End If
    End If


    currPath = ActiveDocument.Path

    'links need double for some reason
    currPath = Replace(currPath, "\","\\")

    'text to replace with
    pReplaceTxt = "LINK Excel.Sheet.12 """ & currPath & "\\" & pReplaceTxt & ".xlsx"

    Application.ActiveWindow.View.ShowFieldCodes = True
    'Fix the skipped blank Header/Footer problem
    lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType

    'Iterate through all story types in the current document
    For Each rngStory In ActiveDocument.StoryRanges

        'Iterate through all linked stories
        Do
            SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
            On Error Resume Next
            Select Case rngStory.StoryType
                Case 6, 7, 8, 9, 10, 11
                    If rngStory.ShapeRange.Count > 0 Then
                        For Each oShp In rngStory.ShapeRange
                            If oShp.TextFrame.HasText Then
                                SearchAndReplaceInStory oShp.TextFrame.TextRange, pFindTxt, pReplaceTxt
                            End If
                        Next
                    End If
                Case Else
                    'Do Nothing
                End Select
                On Error GoTo 0

                'Get next linked story (if any)
                Set rngStory = rngStory.NextStoryRange
            Loop Until rngStory Is Nothing
        Next
        Application.ActiveWindow.View.ShowFieldCodes = False
        ActiveDocument.Fields.Update
End Sub

Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, ByVal strSearch As String, ByVal strReplace As String)
    With rngStory.Find
        .ClearFormatting
        '.Replacement.ClearFormatting
        .MatchWildcards = True
        .Text = strSearch
        .Replacement.Text = strReplace
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
End Sub

当前目录类似于C：\ Users \\ Dropbox \ Project \ 1。规划\\

轻松复制

因为我的代码使用与标准搜索相同的引擎并且替换一个可以通过开始一个新的单词doc in

轻松地重现问题

C:\\Users\\testuser\\Dropbox\\Project\\test\\testproject\\excelfile.xlsm

进行通配符搜索并替换为

C:*.xlsm

作为搜索和

C:\\Users\\testuser\\Dropbox\\Project\\1. Planning\\testproject\\excelfile.xlsm

替换

我想我需要一些方法来逃避我的反斜杠，但我无法找到一种方法来做到这一点

Answer 1

好的，这需要用ascii eqivalent ^ 92替换反斜杠。但是，如果你有数字那么它们就会成为一个问题，如果它们遵循\，那么也需要转换为ascii。

因此，使用函数将替换字符串转换为正确的格式，如下所示

Function convert(inp As String) As String
Dim ret As String
Dim char As String

ret = ""
For i = 1 To Len(inp)
    char = Mid(inp, i, 1)
    If char = "\" Or (char >= "0" And char <= "9") Then
        ret = ret + "^" + Format(Asc(char))
    Else
        ret = ret + char
    End If
Next i
convert = ret
End Function

VBA搜索并替换为通配符：在替换字符串中使用\（反斜杠）也包含数字（错误：5623）

1 个答案: