Köprüler kullanın ve sonra köprüden hedefe kopyalayın.

Question

"Tamam Bu durumda, sağlanan komut dosyası değiştirildi ve artık hiper bağları saymayı atlayıp artık doğru sayıda dosyayı getiriyor, ancak bazı nedenlerle pdfs çoğaltılıyor. Her bir köprünün benzersiz olduğunu ve kaynak konumlarındaki dosya adlarının birbirinden benzersiz olduğunu doğruladım.

Aşağıdaki örnekte, bunu test ettiğim bir liste var: Aslen komut dizim, listede yalnızca ilk pdf'yi getiriyordu Şimdi güncellenmiş betikle tüm örneklere bakar ancak ilk PDF'yi kopyalar.

Kaynaklar şu şekilde gözüküyor:

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

Klasörde ne yapıştırır? Aynı pdf'yi kullanır ve satır sayısını başlangıç ​​olarak ekler. HL'den geçen hiperlinklerdeki Karakterleri okumadığı gibi.

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

Sana Application.Selection özelliği ile çalışmaya devam etmek istediğinizi tahmin edersiniz.

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