Gerald Berger WEB und EDV SERVICE - Gerald Berger Web und EDV Service

Public Sub XCopy32(SourceDrv As String, SourceDIR As String, DestDrv As String, DestDIR As String)
Dim Result As String
Dim W As Integer
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim DIRList() As String
Dim FileList() As String
W = 0
Y = 0
Success = False
On Error Resume Next
ChDrive SourceDrv
If Not Err = 0 Then Exit Sub
ChDir (SourceDrv & "\" & SourceDIR)
If Not Err = 0 Then Exit Sub
ChDrive DestDrv
If Not Err = 0 Then Exit Sub
ChDir (DestDrv & "\" & DestDIR)
If Not Err = 0 Then
Err = 0
MkDir (DestDrv & "\" & DestDIR)
If Not Err = 0 Then Exit Sub
End If
On Error GoTo 0
Result = Dir((SourceDrv & "\" & SourceDIR & "\*.*"), vbDirectory)
Do
If (Result = "." Or Result = "..") = False Then<br /></span></span><span style="font-family: Courier New;"> Exit Do
Else
Result = Dir()
End If
Loop
Do
If Result = "" Then Exit Do
If (GetAttr(SourceDrv & "\" & SourceDIR & "\" & _
Result)) = vbDirectory Then
W = W + 1
ReDim Preserve DIRList(W)
DIRList(W) = Result
Else
Y = Y + 1
ReDim Preserve FileList(Y)
FileList(Y) = Result
End If
Result = Dir()
Loop
For X = 1 To W
Call XCopy32(SourceDrv, (SourceDIR & "\" & DIRList(X)), DestDrv, (DestDIR & "\" & DIRList(X)))
If Success = False Then Exit Sub
Next X
For Z = 1 To Y
FileCopy (SourceDrv & "\" & SourceDIR & "\" & FileList(Z)), _
(DestDrv & "\" & DestDIR & "\" & FileList(Z))
Next Z
Success = True
End Sub