Discussion :

[pasnaz]

Bonjour
Je transfert depuis access un fichier texte de 2Mo sur un serveur ftp. hors depuis une semaine le fichier ainsi transmis fait 0 ko une fois sur le ftp.
D'apres la hot line de l'hebergeur ftp il faut essayer d'augementer le timeout car le fichier n'est pas completement copier.

voila le code qui fonctionnait depuis 2 ans ! que faut il rajouter pour augmenter le delai timeout ?

ou alors quelqu'un a t il une idée sur la question.

Pour info je peux copier manuellement le fichier depuis windows
J'arrive a copier egalement avec un systeme de sauvegarde automatique (super flexible synchonizer). Donc ca n'est pas un probleme de parefeu.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Function EnvoiVersFtp()
 
Dim HwndConnect As Long
Dim HwndOpen As Long
'Ouvre internet
HwndOpen = InternetOpen("SiteWeb", 0, vbNullString, vbNullString, 0)
'Connection au site ftp
HwndConnect = InternetConnect(HwndOpen, "ftp.mont.com", 21, _
"log", "pass", 1, 0, 0)
'positionnement du curseur dans le répertoire
FtpSetCurrentDirectory HwndConnect, "table_catalogue"
 
FtpPutFile HwndConnect, "\\SERVEUR\mont\Web Montaz\table_catalogue\ServiceAtelier", "ServiceAtelier.jpg", &H0, 0
 
 
InternetCloseHandle HwndConnect 'Ferme la connection
InternetCloseHandle HwndOpen 'Ferme internet

[naphta]

Bonjour,

Si après la session FTP le fichier existe mais qu'il fait 0K c'est que l'authentification c'est bien déroulée, le déplacement vers le dossier de dépôt aussi.
On peut donc penser que c'est soit un souci de timeout soit un bug de la biblio.

J'ai cherché avec le google d'autres personnes ont eu le même souci sans solutions.

Les tests que tu fais ne sont-ils des tests FTP ?
Sinon une suggestion :

tentes de faire des tests avec Filezilla ou IEX qui a les services FTP intégrés à l'instar de Firefox.
Ensuite construit un vbs qui va faire du FTP et que tu pourras appeler d'access.
Sinon il y a bien un serveur FTP français GENE6FTP qui possède des objets com, 35€, que j'utilise depuis 4 ans interfacé avec Access. Un produit très sympathique comme son créateur.

a+

[pasnaz]

Je pensais justement au timeout
comment l'augmenter dans une commande VB ?

[LedZeppII]

Bonsoir,

A essayer.

Là où tu déclares tes fonctions API ftp, ajoutes ces déclarations

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Const INTERNET_OPTION_SEND_TIMEOUT = 5&
 
Private Declare Function InternetSetOption Lib "Wininet.dll" Alias "InternetSetOptionA" _
       (ByVal hInternet As Long, ByVal dwOption As Long, _
        lpBuffer As Any, ByVal lpdwBufferLength As Long) As Long
 
Private Declare Function InternetQueryOption Lib "Wininet.dll" Alias "InternetQueryOptionA" _
       (ByVal hInternet As Long, ByVal dwOption As Long, _
        lpBuffer As Any, ByRef lpdwBufferLength As Long) As Long

Si besoin change Private en Public.

Dans ton code, ajoute deux variables

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim lgTimeout As Long, lgOptionSize As Long

Juste après

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Ouvre internet
HwndOpen = InternetOpen("SiteWeb", 0, vbNullString, vbNullString, 0)

ajoute

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
lgOptionSize = Len(lgTimeout)
lgTimeout = 300000  ' ms
InternetSetOption HwndOpen, INTERNET_OPTION_SEND_TIMEOUT, lgTimeout, lgOptionSize

Et si tu veux vérifier que la valeur du timeout a bien été prix en compte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
lgOptionSize = Len(lgTimeout)
If InternetQueryOption(HwndOpen, INTERNET_OPTION_SEND_TIMEOUT, _
                       lgTimeout, lgOptionSize) <> 0 Then
    Debug.Print "SEND_TIMEOUT : " & lgTimeout & "ms"
End If

Chez moi j'ai un timeout par défaut de 5mn (300000ms).
J'ai quelques doutes sur cette piste.

Pour récupérer un éventuel message d'erreur, ajouter ces déclarations API

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
' FormatMessage
Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
 
Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" ( _
         ByVal dwFlags As Long, ByVal lpSource As Long, _
         ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
         ByVal lpBuffer As String, ByVal nSize As Long, _
         ByVal Arguments As Long) As Long
 
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" _
        (ByVal lpszModuleName As String) As Long

Et voici une fonction pour récupérer le message associé à une erreur:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Function TranslateWinError(lngErr As Long, Optional strModuleName As String = "")
Dim strMsg As String, hModule As Long, lgFmt As Long, lgRetVal As Long
If Len(strModuleName) = 0 Then
   hModule = 0  ' Message d'erreur Windows
   lgFmt = FORMAT_MESSAGE_FROM_SYSTEM
Else
   hModule = GetModuleHandle(strModuleName)
   lgFmt = FORMAT_MESSAGE_FROM_HMODULE
End If
strMsg = String(1024, vbNullChar)
lgRetVal = FormatMessage(lgFmt, hModule, lngErr, 0, strMsg, 1023, 0)
strMsg = Left(strMsg, InStr(1, strMsg, vbNullChar) - 1)
TranslateWinError = strMsg
End Function

Utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If FtpPutFile(HwndConnect, "\\SERVEUR\mont\Web Montaz\table_catalogue\ServiceAtelier", _
              "ServiceAtelier.jpg", &H0, 0)=0 Then
   MsgBox TranslateWinError(Err.LastDllError, "wininet.dll")
End If

A+