Nehmen Sie Hyperlinks und kopieren Sie dann von Quelle zu Ziel mit Hilfe von Hyperlink-Referenzen

Question

"OK So modifiziert das mitgelieferte Skript und es nicht mehr überspringen Hyperlinks zählen und bringt die richtige Anzahl von Dateien jetzt aber es kopiert PDFs aus irgendeinem Grund. Ich habe überprüft, dass jeder Hyperlink eindeutig ist und die Dateinamen in den Quellorten sind eindeutig voneinander

Beispiel unten ist eine Liste, die ich getestet habe .. Ursprünglich mein Skript würde nur in der ersten PDF in der Liste Jetzt mit dem aktualisierten Skript sieht es alle Instanzen, aber dupliziert die erste PDF-Datei.

Sources seine Blick auf.

..\..\..\..\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 

Was es in Ordner einfügt. Es verwendet dasselbe PDF und fügt die Zeilennummer zu Beginn hinzu. Es ist wie es nicht die Zeichen in den Hyperlinks nach dem HL lesen.

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

Ich werde davon ausgehen, dass Sie mit der Application.Selection Eigenschaft weiterarbeiten wollen.

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