VBA search and replace with wildcards: using \ (backslash) in replace string also containing numbers (error: 5623)

StackOverflow https://stackoverflow.com/questions/23680780

Premiss:

I have a word document with a lot of { LINKS ... } to an excel document to be able to generate word documents easier. When i move these documents to a new directory i want to update all links with the new dir and possibly a new excel docname as well.

Problem:

I have found on stackoverflow and other sites a vba/macro that mostly does what i need. The problem arises when i do a wildcard .find .replace where the replace text contains \ and the dirname has numbers.

Code:

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

current dir is something like C:\Users\\Dropbox\Project\1. planning\\

Easy reproduction

as my code uses the same engine as the standard search and replace one can easily reproduce the problem by starting a new word doc typing in

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

And the do a wildcard search and replace with

C:*.xlsm

as search and

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

as replace

I figure i need some way of escaping my backslashes but i just cant find a way to do that

有帮助吗?

解决方案

Okay this gets a little more complex you need to replace the backslashes with the ascii eqivalent ^92. However as you have numbers as well then they become a problem if they follow a \ so need converting to ascii as well.

So use a function to convert the replacement string to the correct format like below

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
许可以下: CC-BY-SA归因
不隶属于 StackOverflow
scroll top