FTP InternetConnect renvoie 0

**DonKnacki** · 30/01/2012, 08h58

Bonjour à tous,

J'ai besoin d'uploader des fichiers issues de ma base Access sur un serveur FTP
J'ai donc utiliser les API Windows et notamment PutFtpFile

J'ai un souci puisque depuis peu (j'ai bien du modifier quelque chose mais va savoir quoi

) la fonction InternetConnect me renvoie 0 et donc je ne peux pas aller plus loin.

A noter qu'il faudrait que mon script soit utilisable sur la version 2003 comme 2007

Pour le moment, j'ai ça :

Code vba :

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
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
 
'-------------------
'Déclaration des API
'-------------------
 
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFile As Long, ByVal localFile As String, ByVal newRemoteFile As String, ByVal dwFlags As Long, ByVal lContext As Long) As Boolean
Public Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
 
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
 
Private Const scUserAgent = "VB OpenUrl"
Private Const INTERNET_FLAG_RELOAD = &H8000000  '(&H8000000 mode passif, 0 mode actif)
Private Const INTERNET_bin_asc = &H2            '(&H1 ascii, &H2 binaire)
 
' -----------------------
' Constantes
' -----------------------
' FormatMessage
Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
 
' ----------------------------------------------------------------------
' Functions de l'API Windows
' ----------------------------------------------------------------------
Private Declare Function GetLastError Lib "kernel32.dll" () As Long
 
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
 
 
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
 
Public Sub Upload(sURL As String, sLogin As String, sPwd As String, localFile As String, remoteDir As String, remoteSaveAs As String)
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)
    Dim hOpen As Long
    Dim hOpenFtp As Long
    Dim bRet As Boolean
    Dim sMsg As String
 
    'lancer le transfert
    hOpen = InternetOpen("PutFtpFile", 1, "", "", 0)
    If hOpen = 0 Then
        'MsgBox "connection internet impossible"
        Exit Sub
    End If
    hOpenFtp = InternetConnect(hOpen, sURL, 21, sLogin, sPwd, 1, INTERNET_FLAG_RELOAD, 0)
    If hOpenFtp = 0 Then
        'MsgBox "connection  impossible"
        Exit Sub
    End If

Je peux mettre un peu plus de code si besoin mais je pencherai plus pour une référence absente mais laquelle ?
Évidemment j'ai testé la connexion au ftp via FilleZilla au préalable

**LedZeppII** · 30/01/2012, 20h26

Bonsoir,

Essaie de tester comme ça, pour voir si TranslateWinError peut te mettre sur une piste :

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
18
19
20
21
22
23
24
25
26
27
28
29
Sub tstUpload()
Upload "NomServeurFtp.fr", "NomUtilisateur", "MotDePasse", "", "", ""
End Sub
 
Public Sub Upload(sURL As String, sLogin As String, sPwd As String, localFile As String, remoteDir As String, remoteSaveAs As String)
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)
    Dim hOpen As Long
    Dim hOpenFtp As Long
    Dim bRet As Boolean
    Dim sMsg As String, lgLastDllErr As Long
 
    'lancer le transfert
    hOpen = InternetOpen("PutFtpFile", 1, "", "", 0)
    If hOpen = 0 Then
        'MsgBox "connection internet impossible"
        Exit Sub
    End If
    hOpenFtp = InternetConnect(hOpen, sURL, 21, sLogin, sPwd, 1, INTERNET_FLAG_RELOAD, 0)
    If hOpenFtp = 0 Then
        'MsgBox "connection  impossible"
        lgLastDllErr = Err.LastDllError
        sMsg = TranslateWinError(lgLastDllErr, "wininet.dll")
        MsgBox sMsg
        Exit Sub
    End If
 
    InternetCloseHandle hOpenFtp
    InternetCloseHandle hOpen
End Sub

A+

**DonKnacki** · 01/02/2012, 10h29

Merci pour ton aide

Je n'ai pas utilisé ton script (pour le moment) car la connexion s'effectue à nouveau. Je ne comprend pas trop comment mais bon . Tout ce que je peux dire c'est que j'ai joué sur le 2010 puis 2003 et enfin 2007. (oui notre parc est très homogène).
Je retiens néanmoins la fonction la fonction TranslateWinError que je ne connaissais pas et qui me sera peut être utile

Je met quand même en résolu même si je reste perplexe

FTP InternetConnect renvoie 0 [Toutes versions]

VBA Access

Vue hybride

Discussions similaires

Partager

Partager