Dosya Birleştirme

[quantum32]

Selam,

Sorum Excelle alakalı değil, ancak yardım alabilirim diye buraya yazıyorum.

13 farlı klasörüm var. Bunların içinde de belli sayıda ve isimleri biribirinden farklı pdf dosyalarım var. İstediğim bir programla veya windows komutu (tercihimdir.) ile bu 13 farklı klasördeki belgeleri tek bir klasöre toplamak. Tek tek bu 13 klasörü açıp içindekileri bir yere kopyalamak zaman alıyor. Yardımcı olabilirsenzi sevinirm.

Teşekkürler,

 

[hamitcan]

A sütununa kaynak klasörlerin yolunu, B2 hücresine ise hedef klasörün, yolunu yazın.

Sub Move_Certain_Files_To_New_Folder2()
'This example move all Excel files from FromPath to ToPath.
'Note: It will create the folder ToPath for you with a date-time stamp
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Dim FNames As String
For i = 2 To [a65536].End(3).Row
    FromPath = Cells(i, 1) '<< Change
    ToPath = [b2] '& Format(Now, "yyyy-mm-dd h-mm-ss") _
           & " Excel Files" & "\"    '<< Change only the destination folder

    FileExt = "*.pd*"   '<< Change
    'You can use *.* for all files or *.doc for word files

    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If

    FNames = Dir(FromPath & FileExt)
'    MsgBox FNames
    If Len(FNames) = 0 Then
        MsgBox "Hiç Bir Dosya Bulunamadı." & FromPath
        Exit Sub
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

'    FSO.CreateFolder (ToPath)
On Error GoTo hata
    FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
Next
MsgBox "Aktarım Bitmiştir."
hata:
If Err.Number = 58 Then MsgBox "Aynı İsimde Dosyalar Mevcut Olabilir."
End Sub

Kodlar Alıntıdır.
http://www.rondebruin.nl/folder.htm

 

[SSEN]

( c:\dosya1\*.pdf ) 13 farlı klasörün
( c:\hepsi ) toplayacağın yer hedef noktası

dosya isimlerini kendine göre ayarlarsın klasör isminde tr karakter olmasın boşluk var ise " " içine al (örnek "yeni dosya" ) komutları txt yapıştır daha sonra uzantısnı BAT olarak değiştir. doyyayı çift tıklayınca komutlar çalışır.


cd\
xcopy c:\dosya1\*.pdf c:\hepsi
xcopy c:\dosya2\*.pdf c:\hepsi
xcopy c:\dosya3\*.pdf c:\hepsi
xcopy c:\dosya4\*.pdf c:\hepsi
xcopy c:\dosya5\*.pdf c:\hepsi
xcopy c:\dosya6\*.pdf c:\hepsi
xcopy c:\dosya7\*.pdf c:\hepsi
xcopy c:\dosya8\*.pdf c:\hepsi
xcopy c:\dosya9\*.pdf c:\hepsi
xcopy c:\dosya10\*.pdf c:\hepsi
xcopy c:\dosya11\*.pdf c:\hepsi
xcopy c:\dosya12\*.pdf c:\hepsi
xcopy c:\dosya13\*.pdf c:\hepsi
xcopy c:\dosya14\*.pdf c:\hepsi
pause