Sub Déplacer(ByVal NomFic As String, ByVal ChDépart As String, ByVal ChArrivée As String)
Dim TSp() As String, P As Long, Inexistant As Boolean
If Right$(ChDépart, Len(NomFic) + 1) <> "\" & NomFic Then
TSp = Split(ChDépart, "\")
ReDim Preserve TSp(0 To UBound(TSp) + 1)
TSp(UBound(TSp)) = NomFic
ChDépart = Join(TSp, "\"): End If
On Error Resume Next: ChDir ChArrivée
Inexistant = Err > 0: On Error GoTo 0
If Inexistant Then
ChDrive ChArrivée
TSp = Split(ChArrivée, "\")
ChDir TSp(0) & "\"
For P = 1 To UBound(TSp)
On Error Resume Next: ChDir TSp(P)
Inexistant = Err > 0: On Error GoTo 0
If Inexistant Then
MkDir TSp(P)
ChDir TSp(P)
End If: Next P: End If
On Error Resume Next
Name ChDépart As ChArrivée & "\" & NomFic
If Err Then
Dim Z As String
Z = "CurDir = """ & CurDir & """."
If Dir(ChDépart) = "" Then Z = Z & vbLf & """" & ChDépart & """ n'existe pas."
If Dir(NomFic) = NomFic Then Z = Z & vbLf & """" & CurDir & "\" & NomFic & """ existe déjà."
Z = Z & vbLf & "Name """ & ChDépart & """ As """ & ChArrivée & "\" & NomFic & """" _
& vbLf & "==> Erreur " & Err.Number & " :" & vbLf & Err.Description
MsgBox Z, vbCritical, "Déplacer": End If
End Sub