Hi,
Each time you put a new version of you spreadsheet, put a script files on
your FTP with a release version like 1,2,3...., and download this script and
compare this version with the local script and use my code to download if
necessary.
Best regards (sorry for my cheap english)
Robert Simard
Logipro
http://www.logicielappui.com/tips
'// Code Start
Option Compare Database
Option Explicit
Private Const MAX_PATH = 260
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_MULTIPART = &H200000
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
Global FTP_Server As String
Global FTP_User As String
Global FTP_PassW As String
Global glbSize As String
Global StopTransfert As Boolean
Const FTP_UAgent = "FTP Demo"
Dim hOpen As Long
Dim hConnection As Long
Dim Transfer As Long
Dim hFile As Long
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 InternetGetLastResponseInfo Lib "wininet.dll" Alias
"InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As
String, lpdwBufferLength As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet
As Long) As Integer
Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA"
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As
Long, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long,
lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hFile As
Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long,
dwNumberOfBytesWritten As Long) As Integer
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias
"FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String)
As Long
Public Function FTPConnect(FServer As String, _
FUser As String, _
FPass As String) As Boolean
'// Connection au FTP
FTPConnect = True
FTP_Server = FServer
FTP_User = FUser
FTP_PassW = FPass
DoCmd.Hourglass True
hOpen = InternetOpen(FTP_UAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString,
vbNullString, 0)
If hOpen <> 0 Then
hConnection = InternetConnect(hOpen, FTP_Server, _
INTERNET_INVALID_PORT_NUMBER, _
FTP_User, _
FTP_PassW, _
INTERNET_SERVICE_FTP,
INTERNET_FLAG_PASSIVE, 0)
If hConnection = 0 Then
MsgBox "Impossible de se connecter au serveur FTP avec le nom
d'utilisateur et le mot de passe spécifiés.", vbExclamation, "Erreur de
connection"
FTPDisconnect
FTPConnect = False
End If
Else
MsgBox "Impossible d'ouvrir votre connection Internet.",
vbExclamation, "Erreur de connection"
FTPConnect = False
End If
DoCmd.Hourglass False
End Function
Public Function DownloadFTPFiles(strFile As String, strNewFile As String,
lngFileSize As Long) As Boolean
'// Télécharge un fichier sur un site FTP
Dim hFile As Long
Dim sBuffer As String
Dim sReadBuffer As String * 4096 'par tranche de 4k
Dim lNumberOfBytesRead As Long
Dim bDoLoop As Boolean
Dim Sum As Long
hFile = FtpOpenFile(hConnection, Trim(strFile), GENERIC_READ, Transfer,
0)
Open strNewFile For Binary Access Write As #2
bDoLoop = True
While bDoLoop
If StopTransfert = True Then GoTo StopGetFiles
sReadBuffer = vbNullChar
bDoLoop = InternetReadFile(hFile, sReadBuffer, Len(sReadBuffer),
lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Sum = Sum + lNumberOfBytesRead
'UpdateProgressMeter "Téléchargement", Sum, Val(lngFileSize),
"Téléchargement", Val(Sum)
Wend
Put #2, , sBuffer
StopGetFiles:
Close #2
InternetCloseHandle (hFile)
End Function
Public Function UploadFTPFiles(lFile, ShortFile, FileSize As Long)
'// Envois un fichier sur un FTP
'//Exemple :SendFTPFiles "c:\bob.exe", "bob.exe"
Dim Data(99) As Byte ' array of 100 elements 0 to 99
Dim Written As Long
Dim Size As Long
Dim Sum As Long
Dim j As Long
Sum = 0
j = 0
hFile = FtpOpenFile(hConnection, ShortFile, GENERIC_WRITE, Transfer, 0)
If hFile = 0 Then Exit Function
Open lFile For Binary Access Read As #1
Size = LOF(1)
glbSize = Size
For j = 1 To Size \ 100
If StopTransfert = True Then GoTo StopSendFTPFiles
Get #1, , Data
If (InternetWriteFile(hFile, Data(0), 100, Written) = 0) Then Exit
Function
DoEvents
Sum = Sum + 100
'UpdatePB Sum, FileSize
Next j
Get #1, , Data
If (InternetWriteFile(hFile, Data(0), Size Mod 100, Written) = 0) Then Exit
Function
Sum = Sum + (Size Mod 100)
'UpdatePB Sum, FileSize (this is my forms progressbar)
Close #1
InternetCloseHandle (hFile)
Exit Function
StopSendFTPFiles:
Close #1
InternetCloseHandle (hFile)
hFile = FtpDeleteFile(hConnection, ShortFile)
glbSize = 0
End Function
Private Function GetStatus() As String
'// Retourne le status de le connection
Dim Buffer$, L&, Inf&, AA$
InternetGetLastResponseInfo Inf, vbNullString, L
If Inf Then
Buffer = String(L + 1, 0)
InternetGetLastResponseInfo Inf, Buffer, L
AA = Inf & " " & Buffer
Else
AA = " Ok"
End If
GetStatus = AA
End Function
Public Sub FTPDisconnect()
InternetCloseHandle hConnection
InternetCloseHandle hOpen
GetStatus
hConnection = 0
hOpen = 0
End Sub
Public Sub DelFTPFiles(fFiles As String)
FtpDeleteFile hConnection, fFiles
End Sub
'\\ Code End
