Question

＆＃34;确定因此修改了提供的脚本，它不再跳过计算超链接，并且现在引入了正确数量的文件，但由于某种原因它正在复制pdf。我已经验证每个超链接都是唯一的，并且源位置中的文件名彼此唯一。

以下示例是我在其上测试过的列表。最初我的脚本只会带来列表中的第一个pdf。现在使用更新的脚本，它会查看所有实例，但会复制第一个PDF。

来看看它。

..\..\..\..\Cutsheets\Delta\Software\01 - Controller - Delta - DOW-340-HL.pdf
..\..\..\..\Cutsheets\Delta\Software\01 - Controller - Delta - DOW-340-HL-I.pdf
..\..\..\..\Cutsheets\Delta\Software\01 - Controller - Delta - DOW-340-HM.pdf
..\..\..\..\Cutsheets\Delta\Software\01 - Controller - Delta - DOW-340-HM-I.pdf
..\..\..\..\Cutsheets\Delta\Software\01 - Controller - Delta - DOW-340-HS.pdf
..\..\..\..\Cutsheets\Delta\Software\01 - Controller - Delta - DOW-340-HS-I.pdf

它贴在文件夹中的内容。它使用相同的pdf并将行号添加到开头。它就像不读取HL之后的超链接中的字符。

01 - Controller - Delta - DOW-340-HL.pdf

36-01 - Controller - Delta - DOW-340-HL.pdf

37-01 - Controller - Delta - DOW-340-HL.pdf

38-01 - Controller - Delta - DOW-340-HL.pdf

39-01 - Controller - Delta - DOW-340-HL.pdf

40-01 - Controller - Delta - DOW-340-HL.pdf

Public Sub CopyFile2()
Dim rng As Range
Const strNewDir As String = "D:\test\"

For Each rng In Range("L9:L1017").SpecialCells(xlCellTypeVisible)
  If CBool(rng.Hyperlinks.Count) Then
      With rng.Hyperlinks(1)
          If CBool(InStr(.Address, Chr(92))) Then
              If Dir(strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))) = "" Then
                  FileCopy .Address, _
                  strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))
              Else
                  FileCopy .Address, _
                  strNewDir & rng.Row & "-" & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))
              End If
          Else
              If Dir(strNewDir & .Address) = "" Then
                FileCopy .Address, _
                strNewDir & .Address
              Else
                  FileCopy .Address, _
                  strNewDir & rng.Row & "-" & .Address
              End If
          End If
      End With
  End If
  Next rng
End Sub

Answer 1

我会假设你想继续使用Application.Selection属性。

Public Sub CopyFile()
    Dim rng As Range
    Const strNewDir As String = "D:\test\"

    For Each rng In Selection.SpecialCells(xlCellTypeVisible)
        If CBool(rng.Hyperlinks.Count) Then
            With rng.Hyperlinks(1)
                If CBool(InStr(.Address, Chr(92))) Then
                    FileCopy .Address, _
                      strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))
                Else
                    FileCopy .Address, _
                      strNewDir & .Address
                End If
            End With
        End If
    Next rng
End Sub

获取超链接，然后使用超链接引用从源复制到目标

1 个答案: