Option Explicit
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 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 FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias _
"FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, _
ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" _
Alias "InternetFindNextFileA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Private Declare Function IsNetworkAlive Lib "SENSAPI.DLL" _
(ByRef lpdwFlags As Long) As Long
Const MAX_PATH = 260
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Sub Test()
Dim lngINet As Long
Dim lngINetConn As Long
Dim pData As WIN32_FIND_DATA
Dim lngHINet As Long
Dim intError As Integer
Dim strTemp As String
Dim blnRC As Boolean
Dim nomFichier As String
Dim ItUpdate As Integer, x As Integer
Dim Reponse As String
Select Case IsNetworkAlive(0)
Case 0
MsgBox "Vous n'etes pas connecté"
Exit Sub
'Case 1
'MsgBox "connected to LAN"
'Case 2
'MsgBox "connected to WAN"
'Case Else
'MsgBox "connected to other network"
End Select
lngINet = InternetOpen("Controle FTP", 1, vbNullString, vbNullString, 0)
lngINetConn = InternetConnect(lngINet, "ftp.Provider.fr", 0, _
"MonProfil", "MotDePasse", 1, 0, 0)
pData.cFileName = String(260, 0)
lngHINet = FtpFindFirstFile(lngINetConn, "*.xls", pData, 0, 0)
If lngHINet = 0 Then
intError = Err.LastDllError
Else
nomFichier = Left(pData.cFileName, _
InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
x = Val(Mid(nomFichier, 14))
If x > ItUpdate Then ItUpdate = x
Do
pData.cFileName = String(260, 0)
blnRC = InternetFindNextFile(lngHINet, pData)
If Not blnRC Then
intError = Err.LastDllError
If intError = 18 Then Exit Do
Else
nomFichier = Left(pData.cFileName, _
InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
x = Val(Mid(nomFichier, 14))
If x > ItUpdate Then ItUpdate = x
End If
Loop
End If
Reponse = MsgBox("L'index du dernier update est = " & ItUpdate & vbCrLf & _
"Voulez vous télécharger ce fichier?", vbYesNo)
If Reponse = vbYes Then
blnRC = FtpGetFile(lngINetConn, "FichierUpdate" & ItUpdate & ".xls", _
"C:\FichierUpdate" & ItUpdate & ".xls", 0, 0, 1, 0)
DoEvents
End If
InternetCloseHandle lngINetConn
InternetCloseHandle lngINet
End Sub