Option Explicit
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Const MAX_PATH = 260
Private Declare Function IsWindow Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function PostMessage Lib "User32" Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" ( _
ByVal lpClassName As Any, _
ByVal lpWindowName As String) As Long
'API Constants
Public Const GWL_STYLE = -16
Public Const WS_DISABLED = &H8000000
Public Const WM_CANCELMODE = &H1F
Public Const WM_CLOSE = &H10
''''''''''FIN FONCTIONS FENETRES
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''FONCTIONS FTP
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
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
Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" ( _
ByVal hFtpSession As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Declare Function InternetCloseHandle Lib "wininet" (ByVal handle As Long) As Long
''''''''''FIN FONCTIONS FTP
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub AcquisitionFTP()
Dim val1
DownloadFile "ftp.xxx.com", "login", "mot_de_passe", "testFred65200.txt", GetTemporyFolderPath & "testFred65200.txt"
Dim FileNumber As Integer
FileNumber = FreeFile ' Lit le numéro de fichier inutilisé.
Open GetTemporyFolderPath & "info.txt" For Input As #FileNumber 'ouvert en lecture
While Not EOF(FileNumber)
Input #FileNumber, val1
['Feuil1'!A1] = val1
Wend
Close #FileNumber
'Suppression du fichier temp
Kill GetTemporyFolderPath & "info.txt"
MsgBox "ok"
End Sub
Sub RestitutionFTP() 'J@C, Christian Herbé, Michel Pierron, Flo Cabon, Fred65200
Dim nomClasseur As String
Dim InternetOK
Dim FtpOK
Dim FtpServeur As String
Dim FtpLogin As String
Dim FtpPass As String
Dim DossierDistant As String
Dim FichierDistant As String
Dim FichierLocal As String
Dim Resultat
Dim Internet_OK
Dim FTP_OK
Dim Select_DossierDistant
Dim classeur As Workbook
Dim FileNumber As Integer
Dim Succès As Boolean
FileNumber = FreeFile '1er numéro libre
Open GetTemporyFolderPath & "testFred65200.txt" For Output As #FileNumber
Print #FileNumber, ['Feuil1'!A1] ' écrit dans le fichier
Close #FileNumber
nomClasseur = "testFred65200.txt"
FichierDistant = "testFred65200.txt"
FichierLocal = GetTemporyFolderPath & nomClasseur
DossierDistant = "" 'racine du site
FtpServeur = "ftp.xxxx.com"
FtpLogin = "login"
FtpPass = "mot de passe"
'transférer les fichiers
Const FTP_TRANSFER_TYPE_BINARY = &H2
'Vérifier l'esistence du fichier local
'Vérifier la connection à internet
InternetOK = InternetOpen("PutFtpFile", 1, "", "", 0)
If InternetOK = 0 Then MsgBox "connection internet impossible": Exit Sub
Const INTERNET_FLAG_PASSIVE = &H8000000
'Vérifier l'accès ftp
FtpOK = InternetConnect(InternetOK, FtpServeur, 21, FtpLogin, FtpPass, 1, INTERNET_FLAG_PASSIVE, 0)
If FtpOK = 0 Then MsgBox "connection FTP impossible": Exit Sub
'mode passif proxy
'transfert du fichier sql
Succès = FtpPutFile(FtpOK, FichierLocal, FichierDistant, FTP_TRANSFER_TYPE_BINARY, 0)
If Succès Then
Resultat = Resultat & FichierDistant & " a été transféré "
Else
Resultat = Resultat & FichierDistant & " n'a pas pu être transféré"
End If
'annoncer le résultat de l'opération
If Resultat <> "" Then
MsgBox Resultat
Else
MsgBox "aucun fichier transféré"
End If
'fermer les pointeurs, ménage
InternetCloseHandle FTP_OK
InternetCloseHandle Internet_OK
'Suppression du fichier temp
Kill GetTemporyFolderPath & "info.txt"
End Sub
'recherche du chemin du fichier temp
Public Function GetTemporyFolderPath() As String
Dim sBuffer As String
Dim RV As Long
sBuffer = String(MAX_PATH, Chr(0))
RV = GetTempPath(MAX_PATH, sBuffer)
GetTemporyFolderPath = Left(sBuffer, RV)
End Function
Function DownloadFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String) As Boolean
Dim ftp As Inet
Set ftp = New Inet
With ftp
.Protocol = icFTP
.RemoteHost = HostName
.UserName = UserName
.Password = Password
.Execute .URL, "Get " + RemoteFileName + " " + LocalFileName
Do While .StillExecuting
DoEvents
Loop
DownloadFile = (.ResponseCode = 0)
End With
Set ftp = Nothing
End Function