简体   繁体   English

Replace(x,y,z)在超链接上不起作用

[英]Replace(x, y, z) not working on hyperlinks

I have workbook with many hyperlinks. 我有很多超链接的工作簿。 Recently workbook was moved to another place (one folder "deeper"). 最近工作簿已移到另一个位置(一个文件夹“更深”)。 Because of that all hyperlinks messed up and now are: 因此,所有超链接都搞砸了,现在是:

file:///\\company\common\shared\VRS\Program Files\documents\example.doc

instead 代替

file:///\\company\common\shared\VRS\documents\example.doc

I am trying to write a macro to remove \\Program Files\\ part from all hyperlinks. 我正在尝试编写宏以从所有超链接中删除\\ Program Files \\部分。 Found some examples in here ; 这里找到一些例子; here ; 在这里 ; here (stackoverflow) and here (another stackoverflow) . 这里(stackoverflow)这里(另一个stackoverflow)

Problem that none of the solution works (nothing is changed) and I am out of ideas what I am doing wrong. 问题是没有一种解决方案有效(什么都没有改变),而且我不知道我在做什么错。

codes I tried: 我试过的代码:

Sub EditHyperlinks()
    Dim lnkH As Hyperlink
    Dim sOld As String
    Dim sNew As String

    sOld = "file:///\\company\common\shared\VRS\Program Files\documents\"
    sNew = "file:///\\company\common\shared\VRS\documents\"

    For Each lnkH In ActiveSheet.Hyperlinks
        lnkH.Address = Replace(lnkH.Address, sOld, sNew)
        lnkH.TextToDisplay = Replace(lnkH.TextToDisplay, sOld, sNew)
    Next
End Sub

Sub FixHyperlinks2()
    Dim wks As Worksheet
    Dim hl As Hyperlink
    Dim sOld As String
    Dim sNew As String

    Set wks = ActiveSheet
    sOld = "file:///\\company\common\shared\VRS\Program Files\documents\"
    sNew = "file:///\\company\common\shared\VRS\documents\"
    For Each hl In wks.Hyperlinks
        hl.Address = Replace(hl.Address, sOld, sNew)
    Next hl
End Sub

 Sub FindReplaceHLinks(sFind As String, sReplace As String, _
        Optional lStart As Long = 1, Optional lCount As Long = -1)

        Dim rCell As Range
        Dim hl As Hyperlink

        For Each rCell In ActiveSheet.UsedRange.Cells
            If rCell.Hyperlinks.Count > 0 Then
                For Each hl In rCell.Hyperlinks
                    hl.Address = Replace(hl.Address, sFind, sReplace, lStart, lCount, vbTextCompare)
                Next hl
            End If
        Next rCell
    End Sub

    Sub Doit()

        FindReplaceHLinks "file:///\\company\common\shared\VRS\Program Files\documents\", "file:///\\company\common\shared\VRS\documents\"    
    End Sub

 Sub test()
        Dim hLink As Hyperlink
        Dim wSheet As Worksheet

        For Each wSheet In Worksheets
           For Each hLink In wSheet.Hyperlinks
                hLink.Address = Replace(hLink.Address, "file:///\\company\common\shared\VRS\Program Files\documents\", "file:///\\company\common\shared\VRS\documents\")
            Next hLink
        Next
    End Sub

Note that I have tried to write address (probably) all the possible variants: beginning file:///\\; 请注意,我试图写出地址(可能)是所有可能的变体:开始file:/// \\; \\ and without any \\ 没有任何

Can somebody point me to right direction? 有人可以指出我正确的方向吗?

PS probably I should mention that files are in local network directory. PS可能我应该提到文件在本地网络目录中。

Something like this should work, you want to split the text on \\ , look for the text entry, then build the string back up. 像这样的事情应该起作用,您想要在\\上分割文本,查找文本条目,然后备份字符串。

Function FixFileNames(FileName As String) As String
    Dim i As Long
    Dim testarr As Variant
    Dim fixedString As String

    testarr = Split(FileName, "\", , vbBinaryCompare)

    For i = LBound(testarr) To UBound(testarr)
        If Not testarr(i) = "Program Files" Then fixedString = fixedString & "\" & testarr(i)
    Next

    FixFileNames = Right$(fixedString, Len(fixedString) - 1)
End Function

Sub Tester()
    Debug.Print FixFileNames("file:///\\company\common\shared\VRS\Program Files\documents\example.doc")
End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM