批量 取文件目录,浏览器中打开
'在第8列中不为空的清空下,从第一列中的超链接中,去目录,放在对应第二列中
Sub ChangeDocumentLinkToFolderLink() On Error Resume Next Dim a As String With ActiveSheet rowmax = .Cells(1048576, 5).End(xlUp).Row For i = 2 To rowmax If .Cells(i, 8) <> "" Then a = ChangeDocumentLinkToFolderLink2(.Cells(i, 1).Hyperlinks(1).Address) .Cells(i, 2).Hyperlinks.add .Cells(i, 2), a End If Next End With End Sub
'取目录
Function ChangeDocumentLinkToFolderLink2(add As String) Set fso = CreateObject("Scripting.FileSystemObject")
ChangeDocumentLinkToFolderLink2 = fso.GetParentFolderName(add)
'For i = Len(add) To 1 Step -1
' If Mid(add, i, 1) = "/" Then
' ChangeDocumentLinkToFolderLink2 = Left(add, i)
' Exit For
' End If
'Next End Function
'浏览器中打开目录地址
Sub opernHyperlinks() On Error Resume Next Dim a As String With ActiveSheet rowmax = .Cells(1048576, 5).End(xlUp).Row For i = 2 To rowmax If .Cells(i, 2).Hyperlinks.Count > 0 Then .Cells(i, 2).Hyperlinks(1).Follow NewWindow:=True ' IE.Navigate .Cells(i, 2).Hyperlinks(1).Address End If Next End With End Sub