Transfert de fichiers contenu dans un répertoire vers un FTP

Bonjour le Forum,

J'ai ci-dessous un code qui me permet de transférer les fichiers contenus dans un répertoire de mon HDD via FTP.

Ce code fonctionne super bien mais si les fichiers se trouvent déjà sur le FTP , une boîte de dialogue s'ouvre pour demander s'il faut remplacer ces fichiers, or

je souheterais que les fichiers soit écrasés sans confirmation (Boîte de dialogue).

Si quelqu'un peut m'aider à trouver cette commande car je cherche depuis plusieurs jours et rien !

Merci d'avance

Sub FTPTransfert()

Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")

path = "D:\XXXXXXXXXXXXXXX"

On Error Resume Next

'Copy Options: 16 = Yes to All
Const copyType = 16

'FTP Wait Time in ms
waitTime = 80000

FTPUser = "XXXXXX"
FTPPass = "XXXXXX"
FTPHost = "XXXXXX"
FTPDir = "/XXX/"

strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Set objFTP = oShell.Namespace(strFTP)

'Upload single file
If objFSO.FileExists(path) Then

Set objFile = objFSO.getFile(path)
strParent = objFile.ParentFolder

Set objFolder = oShell.Namespace(strParent)
Set objItem = objFolder.ParseName(objFile.Name)

WScript.Echo "Uploading file " & objItem.Name & " to " & strFTP
objFTP.CopyHere objItem, copyType
End If

'Upload all files in folder
If objFSO.FolderExists(path) Then
'Code below can be used to upload entire folder
Set objFolder = oShell.Namespace(path)

WScript.Echo "Uploading folder " & path & " to " & strFTP
objFTP.CopyHere objFolder.Items, copyType
End If

If Err.Number <> 0 Then
WScript.Echo "Error: " & Err.Description
End If

'Wait for upload
WScript.Sleep waitTime
End Sub

Bonjour,

Voici une solution possible.

Remplacer le code suivant dans la macro :

'Copy Options: 16 = Yes to All
Const copyType = 16

Par

'Copy Options: 4 = Yes to All (Overwrite)
Const copyType = 4

Bonjour,

Je viens de faire l'essai mais toujours la même boîte de dialogue qui demande si on souhaite remplacer le fichier dans la destination.

Merci quand même pour votre intervention.

Philippe

Bonjour,

Une autre solution possible.

Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")

path = "D:\XXXXXXXXXXXXXXX"

On Error Resume Next

' Copy Options: 4 = Yes to All (Overwrite)
Const copyType = 4

' FTP Wait Time in ms
waitTime = 80000

FTPUser = "XXXXXX"
FTPPass = "XXXXXX"
FTPHost = "XXXXXX"
FTPDir = "/XXX/"

strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Set objFTP = oShell.Namespace(strFTP)

' Upload single file
If objFSO.FileExists(path) Then
    Set objFile = objFSO.getFile(path)
    strParent = objFile.ParentFolder
    Set objFolder = oShell.Namespace(strParent)
    Set objItem = objFolder.ParseName(objFile.Name)

    WScript.Echo "Uploading file " & objItem.Name & " to " & strFTP

    ' Supprime la boîte de dialogue de confirmation
    objFTP.CopyHere objItem, copyType

    ' Attendez que le transfert soit terminé
    WScript.Sleep waitTime
End If

' Upload all files in folder
If objFSO.FolderExists(path) Then
    ' Code below can be used to upload entire folder
    Set objFolder = oShell.Namespace(path)

    WScript.Echo "Uploading folder " & path & " to " & strFTP

    ' Supprime la boîte de dialogue de confirmation
    objFTP.CopyHere objFolder.Items, copyType

    ' Attendez que le transfert soit terminé
    WScript.Sleep waitTime
End If

If Err.Number <> 0 Then
    WScript.Echo "Error: " & Err.Description
End If

Merci pour votre réponse mais ce n'est pas encore ça, belle journée

Bonjour,

je n'ai pas les instructions mais tu devrais trouver facilement :
supprimer d'office (ou renommer avant si tu veux le préserver en cas d'erreur d'écriture) le fichier du FTP avant l'écriture.
A voir s'il y aura une erreur à gérer s'il est absent
eric

Merci de vous intéresser à mon sujet mais mon niveau en programmation n'est pas suffisant pour y arriver, belle journée