[英]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.