Mr Kid,

Tks file excel nya, sekarang sedang dipelajari.Nanti tinggal modif2 dikit. Kalo 
ada kesulitan boleh tanya lagi ya. Mudah2n ga perlu copy manual lagi, ga 
efisien n makan waktu.

Terimakasih Mr Kid.

Milis belajar Excel ini is the best

Mangtab



________________________________
Dari: Kid Mr. <mr.nm...@gmail.com>
Kepada: belajar-excel@yahoogroups.com
Dikirim: Selasa, 8 November 2011 23:35
Judul: Re: [belajar-excel] Mohon Sertakan File Excel Untuk Copy file ke folder 
tertentu


  
Berikut contoh file.
Asumsi sedikit diubah.
Pada email lalu, pembuatan directory destinasi dengan asumsi bahwa semua 
directory cabang telah ada.
Pada file terlampir, asumsinya semua level directory belum ada.

Public Sub KopiFileKatanya()
    Dim sFile As String, sDrive As String, sSourcePath As String
    Dim rngDestPath As Range, rngLoop As Range
    Dim sNewPath() As String, sDestPath As String
    Dim lLevel As Long
    
    sFile = Range("c8").Value                       'ambil nama file
    sSourcePath = Range("c6").Value                 'ambil nama folder source
    'cek eksistensi file dan folder source
    If LenB(sSourcePath) = 0 Then
        MsgBox "Folder source blank", vbCritical, "Gagal"
        Exit Sub
    ElseIf LenB(sFile) = 0 Then
        MsgBox "Nama file blank", vbCritical, "Gagal"
        Exit Sub
    ElseIf LenB(Dir$(sSourcePath & "\" & sFile)) = 0 Then
        MsgBox "Tidak ada nama file " & sFile & " pada folder " & sSourceFile, 
vbCritical, "Gagal"
        Exit Sub
    End If
    
    sDrive = Range("c9").Value                      'ambil nama drive
    'cek eksistensi drive
    If LenB(Dir$(sDrive & "\*", vbNormal + vbDirectory)) = 0 Then
        MsgBox "Tidak ada drive " & sDrive
        Exit Sub
    End If

    ActiveSheet.Calculate                           'karena path destinasi 
pakai formula, calculate sheet supaya pasti diperbarui
    Set rngDestPath = Range("d15:d19")              'init range path destinasi, 
siapa tahu akan dibuat lebih dinamis
    For Each rngLoop In rngDestPath                                 'loop 
setiap cell di range destinasi
        If LenB(rngLoop) <> 0 Then                                  'cek, 
destinasi path ada isinya
            'script di email yang lalu, dengan asumsi,
            'semua folder masing-masing cabang telah ada tapi belum ada sub 
foldernya
            '-----------------------------
            'ketika belum ada seluruhnya, maka gunakan script berikut ini :
            'buat path (asumsi, semua level belum ada)
            sDestPath = 
sDrive                                                          'set path level 
0 (root), yaitu drivenya
            sNewPath() = Split(rngLoop.Value, 
"\")                                      'susun nama folder sampai ke sub, 
berurutan
            For lLevel = 1 To 
UBound(sNewPath)                                          'loop mulai folder 
pertama sampai terakhir
                sDestPath = sDestPath & "\" & 
sNewPath(lLevel)                          'susun path per level
                If LenB(Dir$(sDrive & "\" & sNewPath(lLevel), vbDirectory)) = 0 
Then    'cek path belum ada
                    MkDir 
sDestPath                                                     'buat path
                End If
            Next lLevel
            
            FileCopy sSourcePath & "\" & sFile, rngLoop.Value & "\" & 
sFile             'copy filenya
        End If
    Next rngLoop
End Sub

Wassalamualaikum Wr. Wb.
Kid.


2011/11/8 Kid Mr. <mr.nm...@gmail.com>

Sepertinya ini sangat bermanfaat, mohon kepada penulis bisa kasih attachment 
contoh file, agar mudah mempelajarinya.
>>> Diusahakan ya. Moga-moga ada kesempatan lagi untuk bisa buka Excel seperti 
>>> pagi tadi.
>Andai bersedia mencoba sendiri.
>1. Buat workbook baru. Save As dengan suatu nama (xl 2007 ke atas dengan 
>ekstensi xlsm atau xlsb)
>2. tulis di A1 sampai A5
>
>      f:\cabang1\mydata1\
>       f:\cabang1\mydata2\
>       f:\cabang2\mydata1\
>       f:\cabang2\mydata2\
>       f:\cabang3\mydata1\
>3. ke VBE dengan ALT+F11
>4. menu Insert -> Module
>5. akan ada module baru yang terbentuk, double click Module baru itu biasanya 
>bernama ModuleN dengan N dimulai dari angka 1.
>6. klik ruang penulisan script
>7. Copas dari baris Public Sub sampai End Sub :
>Public Sub KopiFileKatanya()
>
>    '1. deklarasi variabel. Misal dengan object range untuk loop informasi 
>folder destinasi.
>  
dim rngLoop as range
>
>   '2. pastikan file source ada bendanya
>  if lenb(dir$( "c:\temp\BeExcel.pdf" ) ) = 0 then
>     msgbox "tidak ada file source"
>     exit sub
>  endif
>
>  '3. pastikan ada drive destinasi.
> 

'jika drivenya juga berbeda-beda, masukkan bagian ini kedalam loop di langkah 
4, dan sebagai cek pertama. 
> 'Nilai drive bisa diambil dari cell juga.
>  if lenb(dir$( "f:\*" , vbnormal + vbdirectory ) ) = 0 then
>     msgbox "tidak ada drive tujuan"
>     exit sub
>  endif
>
> '4. loop masing-masing folder
>  for each rngloop in range("a1:a5")
>       '5. pastikan ada folder destinasinya. Jika tidak ada, dibuatkan.
>        if lenb( dir$( rngloop.value ) ) = 0 then                  'cek apakah 
>directorynya tidak ada ?
>                mkdir rngloop.value
>        endif
>
>         '6. salin filenya  :: hati-hati, karena file yang telah ada akan 
>di-replace
>         'akibat proses 4, pasti ada drivenya.
>         'akibat proses 5, pasti sudah ada directory destinasinya.
>         filecopy "c:\temp\BeExcel.pdf" , rngloop.value & "BeExcel.pdf"
>  

next rngloop
>End Sub
>
>9. kembali ke worksheet dengan ALT+F11
>10. insert sebuah shape (apa saja)
>11. klik kanan shape itu, pilih assign macro, pilih prosedur bernama 
>KopiFileKatanya lalu tekan OK
>12. save workbook
>13. klik si shape.
>
>Mohon maaf karena belum bisa buka file excel.
>Andai ada error atas script di atas, mohon koreksinya, karena hanya sebuah 
>imajinasi saja.
>
>Regards.
>Kid.
>
>
>
>2011/11/8 agus manggala <agus_ftun...@yahoo.com>
>
> 
>>  
>>Sepertinya ini sangat bermanfaat, mohon kepada penulis bisa kasih attachment 
>>contoh file, agar mudah mempelajarinya.
>>
>>atas perkenannya saya ucapkan trima kasih :)
>>
>>
>>
>>
>>________________________________
>>From: Kid Mr. <mr.nm...@gmail.com>
>>To: belajar-excel@yahoogroups.com
>>Sent: Tuesday, November 8, 2011 4:53 PM
>>Subject: Re: [belajar-excel] Copy file ke folder tertentu
>>
>>
>>  
>>Copy sebuah file ke beberapa directory.
>>
>>Asumsi : 
>>1. fullpathfile source : c:\temp\BeExcel.pdf                     (nilai ini 
>>bisa juga didapat dari nilai cell)
>>2. nama file tujuan adalah tetap, yaitu BeExcel.pdf          (atau jadi nama 
>>yang berbeda yang ditentukan di cell) 
>>3. drive tujuan ke drive f:
>>4. directory path berubah sesuai nilai di range A1:A5 misalnya, yang 
>>susunannya sudah lengkap berupa nama directory nya, seperti :
>>       f:\cabang1\mydata1\
>>       f:\cabang1\mydata2\
>>       f:\cabang2\mydata1\
>>       f:\cabang2\mydata2\
>>       f:\cabang3\mydata1\
>>
>>'1. deklarasi variabel. Misal dengan object range untuk loop informasi folder 
>>destinasi.
>>dim rngLoop as range
>>
>>'2. pastikan file source ada bendanya
>>if lenb(dir$( "c:\temp\BeExcel.pdf" ) ) = 0 then
>>    msgbox "tidak ada file source"
>>    exit sub
>>endif
>>
>>'3. pastikan ada drive destinasi.
>>'jika drivenya juga berbeda-beda, masukkan bagian ini kedalam loop di langkah 
>>4, dan sebagai cek pertama. 
>>'Nilai drive bisa diambil dari cell juga.
>>if lenb(dir$( "f:\*" , vbnormal + vbdirectory ) ) = 0 then
>>    msgbox "tidak ada drive tujuan"
>>    exit sub
>>endif
>>
>>'4. loop masing-masing folder
>>for each rngloop in range("a1:a5")
>>       '5. pastikan ada folder destinasinya. Jika tidak ada, dibuatkan.
>>        if lenb( dir$( rngloop.value ) ) = 0 then                  'cek 
>>apakah directorynya tidak ada ?
>>                mkdir rngloop.value
>>        endif
>>
>>         '6. salin filenya  :: hati-hati, karena file yang telah ada akan 
>>di-replace
>>         'akibat proses 4, pasti ada drivenya.
>>         'akibat proses 5, pasti sudah ada directory destinasinya.
>>         filecopy "c:\temp\BeExcel.pdf" , rngloop.value & "BeExcel.pdf"
>>next rngloop
>>
>>Mungkin begitu kali ya.
>>Kid.
>>
>>
>>2011/11/8 Dewan Deya <dwan...@yahoo.co.id>
>>
>> 
>>>  
>>>Tks Mr Kid
>>>
>>>
>>>Ini lagi coba pakai syntax
>>>FileCopy filename_asal ,  filename_tujuan
>>>
>>>
>>>cuma kesulitan menetapkan distinasi nya, karena path destinasi beda beda 
>>>sesuai dengan cabang yang ada.
>>>Pakai looping.
>>>
>>>
>>>Maaf , masih cupu tentang macro vba
>>>
>>>
>>>Tks atas bantuannya
>>>
>>>
>>>
>>>
>>>
>>>
>>>file terlampir
>>>
>>>
>>>
>>>
>>>
>>>
>>>
>>>
>>>
>>>________________________________
>>>Dari: Kid Mr. <mr.nm...@gmail.com>
>>>Kepada: belajar-excel@yahoogroups.com
>>>Dikirim: Sabtu, 5 November 2011 7:39
>>>Judul: Re: [belajar-excel] Copy file ke folder tertentu
>>>
>>>
>>>
>>>  
>>>Dear Dewan,
>>>
>>>Syntax :
>>>FileCopy filename_asal ,  filename_tujuan
>>>
>>>misal : c:\temp\BeExcel.pdf akan di copy ke d:\data\milis dengan nama tetap 
>>>sebagai BeExcel.pdf
>>>FileCopy "c:\temp\BeExcel.pdf"  , "d:\data\milis\BeExcel.pdf"
>>>
>>>Buat sebuah module di VBE
>>>Buat prosedur berikut :
>>>public sub CopyFileku()
>>>     FileCopy "c:\temp\BeExcel.pdf"  , "d:\data\milis\BeExcel.pdf"
>>>end sub
>>>
>>>Jika semua file pdf, gunakan file xcopy. Jadi ganti FileCopy blah-blah 
>>>dengan :
>>>shell "xcopy c:\temp\*.pdf d:\data\milis\*.pdf"
>>>yang perlu diperhatikan, untuk nama folder yang menggunakan spasi, ganti 
>>>dengan shortnamenya.
>>>
>>>Pada Windows 7 juga ada RoboCopy yang mirip dengan xcopy. Syntax-nya agak 
>>>berbeda sedikit.
>>>Untuk lebih jelasnya, ke CommandPrompt dan coba lihat help nya dengan : 
>>>XCopy /?  atau RoboCopy /?
>>>
>>>Regards.
>>>Kid.
>>>
>>>
>>>2011/11/4 Dewan Deya <dwan...@yahoo.co.id>
>>>
>>> 
>>>>  
>>>>
>>>>
>>>>Dear pakar excel,
>>>>
>>>>
>>>>Saya ada sebuah file pdf  (di folder c:\temp\) yang akan di copy ke folder 
>>>>tertentu.Bagaimana cara membuat macro nya.
>>>>File terlampir.
>>>>
>>>>Terimakasih
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>>
>>>
>>>
>>>
>>
>>
>>
>

 

Kirim email ke