Public Sub Kopiere(Quelle As String, Ziel As String)
  On Error GoTo Kopiere_ErrorHandler
  Const pufflen = 4095
  Dim RestLen As Long
  Dim puffer() As Byte
  Dim Laenge As Long
  Dim rest As Single
  ReDim puffer(pufflen)
  Open Quelle For Binary Access Read As #1
  Open Ziel For Binary Access Write As #2
  Laenge = LOF(1)
  Do Until Seek(1) > Laenge
    RestLen = Laenge - Seek(1)
    If RestLen < pufflen Then ReDim puffer(RestLen)
    Get #1, , puffer
    Put #2, , puffer
    rest = 100 * (Seek(1) / (Laenge + 1))
    Me.Caption = CLng(Seek(1) / 1024) & _
                " KBytes Kopiert von " & CLng(Laenge / 1024) & _
                "  :" & Format(rest, "###0.00") & "%"
    DoEvents
  Loop
  Close #1
  Close #2
Exit Sub
 
Kopiere_ErrorHandler:
  MsgBox (Err.Description)
  Close #1
  Close #2
End Sub

progb.Value = Format(rest, "###0.00")

Gruss

Markus

P.S.
- immer lachen: Es kann nur besser werden!