PDF dosyaları farklı kaydet

[alcinhalim]

Selamlar...
Şimdiden teşekkürler


Bir Excel tablomda a sütünün da.
Ha001
Ha002
Ha003
Ha004
Ha005
......
Ha0099
Ha0100
....
Var.
Dosyalar1 klasörümun içerisinde de.
Fatura Ha00x.pdf dosyam var.


Bu Ha00x.pdf dosyamin aynisini kopyalayıp farklı kaydedip. Excel dosyada a sütünumdaki Ha0xxx ler kadar (100 adet yani Ha001 den Ha0100 e kadar ) 100 adet aynı dosyadan ama her birinin ismi Ha001 den Ha0100 e kadar olan 100 adet dosya yo otomatikman yapmak istiyorum.

Tekrar.
Teşekkürler



.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub PDF_File_Copy()
    Dim File_Path As String, PDF_File As String, New_File As Range
    
    File_Path = "C:\Users\Desktop\Dosyalar1\"
    
    PDF_File = Dir(File_Path & "Ha00x.pdf")
    
    If PDF_File <> "" Then
        For Each New_File In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
            If New_File.Value <> "" Then
                FileCopy File_Path & PDF_File, File_Path & New_File.Value & ".pdf"
            End If
        Next
    End If

    MsgBox "Your transaction is complete."
End Sub

 

[alcinhalim]

Deneyiniz.

Option Explicit

Sub PDF_File_Copy()
    Dim File_Path As String, PDF_File As String, New_File As Range
   
    File_Path = "C:\Users\Desktop\Dosyalar1\"
   
    PDF_File = Dir(File_Path & "Ha00x.pdf")
   
    If PDF_File <> "" Then
        For Each New_File In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
            If New_File.Value <> "" Then
                FileCopy File_Path & PDF_File, File_Path & New_File.Value & ".pdf"
            End If
        Next
    End If

    MsgBox "Your transaction is complete."
End Sub

Hemen deniyorum

Teşekkürler

 

[alcinhalim]

Deneyiniz.

Option Explicit

Sub PDF_File_Copy()
    Dim File_Path As String, PDF_File As String, New_File As Range
   
    File_Path = "C:\Users\Desktop\Dosyalar1\"
   
    PDF_File = Dir(File_Path & "Ha00x.pdf")
   
    If PDF_File <> "" Then
        For Each New_File In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
            If New_File.Value <> "" Then
                FileCopy File_Path & PDF_File, File_Path & New_File.Value & ".pdf"
            End If
        Next
    End If

    MsgBox "Your transaction is complete."
End Sub

Teşekkürler Korhan Beycok işime yaradı.


Bu arada bu benim ana xxx.pdf dosya masa üstünde olsa ve kopyalarida kodla yeni bir klasör oluşturarak yapmak istesem mesela yeniklasorgununtarihi isimli ( yeniklasor10092021 gibi bugün için mesela)

Teşekkürler şimdiden

 

[Korhan Ayhan]

Talebiniz elbette yapılabilir. Fakat neden bu talebinizi ilk mesajınızda belirtmediğinizi merak ettim.

Bir konuya cevap verdikten sonra ve karşı taraftan olumlu dönüş aldıktan sonra diğer sorulara zaman harcamaya çalışıyoruz. Siz böyle sürekli isteklerinizi değiştirirseniz konu uzayıp gider.

Kodu aşağıdaki gibi değiştirip kullanabilirsiniz.

Option Explicit

Sub PDF_File_Copy()
    Dim File_Folder As String, File_Path As String, PDF_File As String, New_File As Range
   
    File_Folder = Environ("UserProfile") & "\Desktop\Yeni Klasör " & Format(Date, "dd_mm_yyyy") & "\"
    
    If Dir(File_Folder, vbDirectory) = "" Then MkDir File_Folder
    
    File_Path = Environ("UserProfile") & "\Desktop\"
   
    PDF_File = Dir(File_Path & "Ha00x.pdf")
   
    If PDF_File <> "" Then
        For Each New_File In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
            If New_File.Value <> "" Then
                FileCopy File_Path & PDF_File, File_Folder & New_File.Value & ".pdf"
            End If
        Next
    End If

    MsgBox "Your transaction is complete."
End Sub

 

[alcinhalim]

Talebiniz elbette yapılabilir. Fakat neden bu talebinizi ilk mesajınızda belirtmediğinizi merak ettim.

Bir konuya cevap verdikten sonra ve karşı taraftan olumlu dönüş aldıktan sonra diğer sorulara zaman harcamaya çalışıyoruz. Siz böyle sürekli isteklerinizi değiştirirseniz konu uzayıp gider.

Kodu aşağıdaki gibi değiştirip kullanabilirsiniz.

Option Explicit

Sub PDF_File_Copy()
    Dim File_Folder As String, File_Path As String, PDF_File As String, New_File As Range
  
    File_Folder = Environ("UserProfile") & "\Desktop\Yeni Klasör " & Format(Date, "dd_mm_yyyy") & "\"
   
    If Dir(File_Folder, vbDirectory) = "" Then MkDir File_Folder
   
    File_Path = Environ("UserProfile") & "\Desktop\"
  
    PDF_File = Dir(File_Path & "Ha00x.pdf")
  
    If PDF_File <> "" Then
        For Each New_File In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
            If New_File.Value <> "" Then
                FileCopy File_Path & PDF_File, File_Folder & New_File.Value & ".pdf"
            End If
        Next
    End If

    MsgBox "Your transaction is complete."
End Sub

çok teşekkürler

sonradan aklıma geldi.
dikkat edeceğim.
teşekkkürler tekrar....