#2) hasanyaprak » 22 Oca 2023 00:27
[quote="hasanyaprak"]TEK BUTONA TIKLAYARAK HEM EXCELE PDF İSİMLERİNİ LİNKLİ AKTARSIN(A5 HÜCRESİNE) HEMDE SEÇMİŞ OLDUĞUM KLASÖRDEKİ PDFLERİ HEDEF KLASÖRE KOPYALASIN İSTEMEKTEYİM.
KAYNAK KLASÖRÜNÜ HER İKİ İŞLEM İÇİN TEK TEK GÖSTERMEM LAZIM.
HER İKİ İŞLEMDE DÜZGÜN ÇALIŞIYOR. SADECE BİR KEZ GÖSTEREYİM.
Kod aşağıdaki gibidir. Teşekkür ederim şimdiden.
Private Sub CommandButton3_Click()
On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.getfolder(klasor_adi)
' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell
Set R = Range("A5")
R.Activate
stDir = klasor_adi
stFile = Dir(stDir & "\*.pdf*")
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = R.Offset(1)
stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlYes
Selection.EntireColumn.AutoFit
Set klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not klasor Is Nothing Then
kaynak = klasor.SELF.Path
If InStr(1, kaynak, "{") > 0 Then GoTo Atla
If Len(kaynak) = 3 Then MsgBox "Bir klasör seçin": Exit Sub
yol1 = kaynak 'hedef klasör
Liste (kaynak)
Set klasor = Nothing
MsgBox "KOPYALAMA TAMAMLANDI. KLASÖRÜ KONTROL EDİNİZ!!"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Özel Arama
