Private Sub baslat_Click()
    Dim buffer() As Byte
 
    'Tek seferde kaç byte okunacağı sabitleri.
    'Bunları daha da değiştirerek kopya hızını artırabilir
    'ya da azaltabilirsiniz...
    Const buff1 = 1048576 '1      MB / per
    Const buff2 = 524288  '0,5    MB / per
    Const buff3 = 262144  '0,25   MB / per
    Const buff4 = 131072  '0,125  MB / per >> Bu Örnekte kullanılan
    Const buff5 = 65536   '0,0625 MB / per
 
    'Diskten (I/O) her seferinde kaç byte okunacak...
    ReDim buffer(1 To buff4)
 
    'İlave işaret "\"
    hedef_dizin = IIf(Right(hedef_dizin, 1) = "\", hedef_dizin, hedef_dizin & "\")
 
    'Hedefte aynı dosya varsa sor...
    If Dir(hedef_dizin & Dir(kaynak_dosya)) <> "" Then
        If MsgBox("Hedefte bu dosya mevcut; üzerine yazılsın mı?", _
            vbExclamation + vbYesNo) = vbYes Then _
            Kill hedef_dizin & Dir(kaynak_dosya)
    End If
 
    'Kaynağı (1) "okumak" için aç; hedefi (2) "yazmak" için aç...
    Open kaynak_dosya For Binary As #1
    Open hedef_dizin & Dir(kaynak_dosya) For Binary As #2
 
        'Durumu ölçebilmek için tam genişliği tut...
        memProgressWidth = progress_ust.Width
 
        'Çakma progressbar takımını hazırla... :-))
        progress_ust.Width = 0
        progress_ust.Visible = True
        progress_yuzde.Visible = True
 
        'Tek seferde kaç byte okunacağını yukarıda belirledik,
        'buna göre döngü kaç kez tekrar edeceğini hesapla...
        donus = Int(LOF(1) / buff4)
 
        For i = 1 To donus
            DoEvents 'çakma progressbarın eş zamanlı güncelliği için gerekli.
            per = i / (donus + 1) 'Yüzdeyi hesapla...
            Get #1, , buffer 'oku...
            Put #2, , buffer 've yaz...
 
            'Çakma progressbarın genişliğini ayarla...
            progress_ust.Width = per * memProgressWidth
 
            'Yüzfeyi de göster...
            progress_yuzde.Caption = "% " & Int(per * 100)
        Next
 
        '---------------------------------------------------------------------'
        'Dönüş sayısı tam olarak byte okumayı karşılayamaz. -ki, hep öyledir-
        'Bir tur fazla dönse buffer fazla geleceğinden kalan byte kadar
        'buffer ayarlıyoruz.
        'En son kalan byte kırıntılarını aşağıdaki gibi okuyoruz...
        If (LOF(1) - LOF(2)) > 0 Then
            'Okunmamış kalan byte kadar buffer ayarla...
            ReDim buffer(1 To (LOF(1) - LOF(2)))
 
            Get #1, , buffer 'oku...
            Put #2, , buffer 've yaz...
 
            'Çakma progressbarın genişliğini ayarla...
            progress_ust.Width = memProgressWidth
 
            'Yüzfeyi de göster...
            progress_yuzde.Caption = "% 100"
        End If
        '----------------------------------------------------------------------'
 
    Close #1
    Close #2
End Sub
 
Private Sub hedef_gozat_Click()
    Set gozat = CreateObject("shell.application"). _
        browseforfolder(0, "Hedef klasörü seçin", 0)
 
    If Not gozat Is Nothing Then hedef_dizin.Value = gozat.self.Path
End Sub
 
Private Sub kaynak_gozat_Click()
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Bir dosya seçin!"
        .Filters.Add "Tüm Dosyalar (*.*)", "*.*", 1
        .InitialView = msoFileDialogViewList
        .Title = "Kopyalanacak dosyayı seçin!"
        dosya_secili_mi = .Show
 
        If Not dosya_secili_mi = 0 Then
            kaynak_dosya.Value = .SelectedItems(1)
        End If
 
    End With
End Sub