Bonjour,

J'utilise le code suivant pour gérer des transferts de fichiers par FTP réalisés par ACCESS vers un serveur WEB

Option Explicit

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
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
'-------------------
'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
 
 
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)
 
 
Public Sub Download(sURL As String, SaveAs As String)
'Exemple :
'      Call Download("http://www.url.com/fichier.zip", "C:\Fichier.zip")
 
    Dim hOpen As Long
    Dim hOpenUrl As Long
    Dim bDoLoop As Boolean
    Dim bRet As Boolean
    Dim sReadBuffer As String * 2048
    Dim lNumberOfBytesRead As Long
    Dim sBuffer As String
    Dim sMsg As String
 
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    hOpenUrl = InternetOpenUrl(hOpen, sURL, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
 
    bDoLoop = True
    While bDoLoop
        sReadBuffer = vbNullString
        bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
        sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
        If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
    Wend
 
    Open SaveAs For Binary Access Write As #1
    Put #1, , sBuffer
    Close #1
 
    If bRet Then
        sMsg = sURL & " a été transféré "
    Else
        sMsg = sURL & " n'a pas pu être transféré"
    End If
 
    If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)
 
    'annoncer le résultat de l'opération
    If sMsg <> "" Then
        'MsgBox sMsg
    Else
        MsgBox "aucun fichier transféré problème d'accès internet"
 
    End If
 
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
 
    '''PARAMETRES************************
    ''sURL = "ftpperso.free.fr"
    ''localFile = "c:\test.log"
    ''sLogin = "zaza"
    ''sPwd = "miaou"
    ''remoteDir = "/"
    ''INTERNET_bin_asc = &H2 '(&H1 ascii, &H2 binaire)
    ''Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)
    '''**********************************
 
    '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
 
    If FtpSetCurrentDirectory(hOpenFtp, remoteDir) = 0 Then
        MsgBox "impossible de trouver le répertoire distant " & remoteDir
        Exit Sub
    End If
 
    'nom du fichier sans le chemin
'    Do While InStr(localFile, "\") > 0
'        localFile = Right(localFile, Len(localFile) - InStr(localFile, "\"))
'    Loop
 
 
 
    'transférer le fichier
    bRet = FtpPutFile(hOpenFtp, localFile, remoteSaveAs, INTERNET_bin_asc, 0)
    If bRet Then
        sMsg = localFile & " a été transféré "
    Else
        sMsg = localFile & " n'a pas pu être transféré"
    End If
 
    'fermer les pointeurs, ménage
    InternetCloseHandle hOpenFtp
    InternetCloseHandle hOpen
 
    'annoncer le résultat de l'opération
    If sMsg <> "" Then
        MsgBox sMsg
    Else
        MsgBox "aucun fichier transféré"
    End If
 
End Sub
et dans le bouton d'envoi des fichiers la commande :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Call Upload("ftp.monsite.com", "LOGIN", "PASSWORD", "C:\export\ecritures.csv", "/www/import", "ecritures.csv")
Mais il semble que sous WINDOWS 8 avec ACCESS 2013 la DLL wininet.dll ne soit pas présente et tout mon programme bug...
Peut on la télécharger et la mettre en place ou la remplacer par ?
Merci de votre aide !