Déplacement de fichier

Comment déplacer un fichier?

Première méthode simple:

Sub deplace()
'La méthode la plus simple consiste à combiner les fonctions "FileCopy" et "Kill" :

FileCopy "C:\ajeter\File.txt", "C:\agarder\File.txt"
Kill "C:\ajeter\File.txt"
End Sub

Ou bien

Sub aideXL97()
Dim OldName, NewName
' Définit les noms de fichiers.
OldName = "ANCFICH": NewName = "NOUVFICH"
Name OldName As NewName ' Renomme le fichier.

' Sous Microsoft Windows:
OldName = "C:\MONREP\ANCFICH"
NewName = "C:\VOTREREP\NOUVFICH"
' Déplace et renomme le fichier.
Name OldName As NewName

' Sur Macintosh:
OldName = "DD:MON DOSSIER:ANCFICH"
NewName = "DD:VOTRE DOSSIER:NOUVFICH"
' Déplace et renomme le fichier.
Name OldName As NewName
End Sub

Ex:
Sub deplace()
Name "c:\ajeter\date.xls" As "c:\ajeter\aaa\date.xls"
End Sub

Deuxième méthode :
Source ? Auteur ?

Option Explicit

'déclarations
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type

Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4

Public Const FOF_SILENT = &H4
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_FILESONLY = &H80
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_NOCONFIRMMKDIR = &H200

Public Const SHARD_PATH = &H2&
Public Declare Function SHFileOperation _
Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long

Function ShellMoveFiles(sFile As String, sDestination As String)
'une fonction pour déplacer les fichiers
Dim r As Long
Dim i As Integer
Dim sFiles As String
Dim SHFileOp As SHFILEOPSTRUCT

sFile = sFile & Chr$(0) & Chr$(0)

'la structure est initialisée
With SHFileOp
.wFunc = FO_MOVE
.pFrom = sFile
.pTo = sDestination
.fFlags = FOF_NOCONFIRMATION
End With

'le fichier est déplacé
r = SHFileOperation(SHFileOp)
End Function

Sub MoveFile()
'changer le répertoire et le nom de fichier
ShellMoveFiles "c:\ajeter\test.xls", "C:\agarder\"
End Sub

Troisième méthode avec demande d'écrasement - Clément Marcotte

Sub copieecrasante()
Dim fso As Object, origine As String
Dim destination As String, reponse As Integer
Dim sortie As Byte, message As String
On Error GoTo camarchepas
origine = "c:\copie\unbeaufichiertexte.txt"
destination = "c:\mes documents\unbeaufichiertexte.txt"
Set fso = CreateObject("scripting.filesystemobject")
fso.MoveFile origine, destination
Exit Sub
camarchepas:
Select Case Err
Case 58
message = "Le fichier " & destination & " existe déjà" & _
vbNewLine & "Désirez vous le supprimer?"
reponse = MsgBox(message, vbQuestion + vbOKCancel, "Erreur")
Select Case reponse
Case vbOK
Kill destination
fso.MoveFile origine, destination
Case Else
sortie = 1
End Select
Case 53
message = "Le fichier " & origine & " n'existe pas" & _
vbNewLine & "Fin du programme"
MsgBox message
Case Else
End Select
End Sub

[top]