Un truc un peut tordu!

[klorane]

Bonsoir à tout le forum.

Pour protéger une application d'analyses que j'ai faites sur excel et eviter sa diffusion à grande echelle et ainsi garder la main dessus j'aurai besoin d'une macro un peu particuliere.

Mon code VBA est protéger par mot de passe donc "impossible" à l'utilisateur d'aller fouiller dedans.

Au moment ou l'utilisateur va lancer le bouton demarrer de mon appli, il faudrait une macro qui aille sur un serveur FTP chercher un fichier TXT, l'ouvre, prend la valeur contenue dans ce fichier et la colle dans une cellule exemple Feuille1: A1

Mon appli fait son travail et une fois terminé

une macro se lance: prend la cellule feuil1 A1 - 1 et sauvegarde dans ce fameux fichier TXT sur le serveur FTP la nouvelle valeur.

En gros shématiquement:

(l'utilisateur ou mon aplli excel et chagent ses données à analyser: jusque là rien)

L'utilisateur clique sur un bouton pour demarrer son analyse de données.
Avant l'analyse, une macro va verifier qu'il reste un solde suffisant d'utilisations sur un serveur FTP (brider par exemple à 1000 utilisations).
La macro rapatrie le nombre de lancements encore possibles.
Si = 0 devoir me contacter pour reinitailiser le compteur.
Si > 0 lancement analyse OK
A la fin de l'analyse, sauvergade automatique sur le serveur FTP du nombre de sessions restantes.
A noter que si impossible de se connecter au serveur FTP lancement impossible de l'analyse et egalement si erreur pour transferer le nombre d'utilisations restrantes=effacement des resultats.

-----
La question lol:

Qui serait en mesure de me faire une macro pour rappatrier une donnée contenue dans un fichier TXT sur un serveur FTP et coller cette valeur dans une cellule.

Serveur FTP type Free : Login et mot de passe

et qui serait aussi en mesure de me faire une macro pour exporter une donnée contenue dans une cellule sur un serveur FTP.

Merci pour votre aide.

Klorane

 

[jeanpierre]

Re : Un truc un peut tordu!

Bonsoir klorane,

J'aurais tendance à dire : le sandwich avec ou sans beurre.... ?

J'ai rien compris quoi.... c'est pour te dire.

 

[klorane]

Je vais faire tres simple :

Qui serait en mesure de me faire une macro pour rappatrier une donnée contenue dans un fichier TXT sur un serveur FTP et coller cette valeur dans une cellule (exemple cellule A1 de la feuille 1)

et qui serait aussi en mesure de me faire une macro pour exporter une donnée contenue dans une cellule sur un serveur FTP. (exemple cellule A1 de la feuille 1)

Le serveur FTP est de type Free : Login et mot de passe pour se connecter dessus

je peux pas faire plus simple. ;-)

Klorane

 

[Brigitte]

Re : Je vais faire tres simple :

Bonsoir,

Même si tu as un pseudo qui sent bon et me ramène plusieurs années en arrière, deux petites choses pour toi :

- soigne tes titres pour allécher les gens qui t'aideront et pour l'avenir de la recherche (pas médicale)

- évite de poster deux fois de suite en l'espace de peu de temps sur le même sujet (peut être un bégaiement sur le clavier ? dans ce cas tu es pardonné (e) ).

Bon courage.

Moi je trouve pas ta question assez simple pour moi... Je m'efface donc.

 

[jmd2]

Re : Un truc un peut tordu!

hello à vous tous

tente ta chance avec AutoIt, ou AutoHotKey + facile je pense, (gratuits) qui permettent de faire des macros Windows, donc de piloter toutes sortes de logiciels (y compris Excel d'ailleurs).
Ton client FTP ne devrait pas faire exception.

il s'agit de scripts, mais des scripts qui "singent" les clics de souris (je simplifie la présentation, c'est beaucoup plus complet)
plus simple que VBA.

********************************************************

Va voir,

 

[fred65200]

Re : Un truc un peut tordu!

bonsoir à) tous
les macros sont là
il te faut ajouter une référence à Microsoft Transfert Internet Control
si tu n'as pas cette référence recherche MSINET.OCX sur ton PC
("C:\Windows\System32\MSINET.OCX") avec le bouton Parcourir.
Si elle n'est pas sur ton PC, télécharge la (Google est ton ami)

Je n'ai pas le temps d'optimiser le code et ne peux le tester pour Free.

Je l'ai tester sur mon serveur ftp et aucun problème pour l'acquisition et la restitution

AcquisitionFTP:
-Téléchargement du fichier dans le dossier temp.
-Lecture de la valeur.
-Inscription de la valeur dans Feuil1!A1.
-Suppression du fichier temporaire.

RestitutionFTP:
-Création d'un fichier dans le dossier temporaire avec la valeur de Feuil1A1.
-Transfert ftp.
-Suppression du fichier temporaire.

Il te faut bien sûr entrer L'hôte, ton login et ton mot de passe
sur les deux macros, c'est pourquoi, entre autre que j'écris que le code n'est pas optimiser.
Dans la mesure du possible, j'ai conservé le nom des auteurs des macros dont le code est largement inspiré.

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

Cordialement

 

[klorane]

Re : Un truc un peut tordu!

Un grand MERCI Fred!

C'est avec plaisir que je vais aller jouer avec ça! (Et j'espere pas avoir à t'embeter pour un renseignement)

Bon week end.

 

[klorane]

Re : Un truc un peut tordu!

Bonjour Fred,

je reiens vers toi var j'ai 2 petits soucis (je pense que c'est rien de bien mechand)

Quand je souhaite faire l'acquisition j'ai un bug (mise en surbrillance jaune) dans les lignes ci-dessous:

Function DownloadFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String) As Boolean

Et sinon quand j'exporte, le fichier s'exporte sans problème mais j'ai un bug à la ligne suivante :

'Suppression du fichier temp
Kill GetTemporyFolderPath & "info.txt"

Vois tu d'ou pourrais provenir le problème?

Merci

klorane

 

[klorane]

Re : Un truc un peut tordu!

pour un problème c'est résolu!

En effet: il s'agissait du nom de fichier info.txt et à la place c'est : testFred65200.txt

Par contre, je seche sur l'autre! ;-)

Function DownloadFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String) As Boolean

 

[fred65200]

Re : Un truc un peut tordu!

re

j'avais vu cette erreur de info.txt en retravaillant dessus.

Je t'ai repréparer une mouture épurée cette fois

Option Explicit
'Déclaration des APIs
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Const MAX_PATH = 260
'Fin APis
'Rensignement des constantes
Public Const strHote As String = "ftp.xxx.com"
Public Const strLogin As String = "login"
Public Const strMotDePasse As String = "mot_de_passe"
Public Const strFichier As String = "testFred65200.txt"   'Ici tu peux mettre n'importe quelle extension de ton choix .klo si tu veux
Public intNumeroFichier As Integer

Sub AcquisitionFTP()
Dim strValeurLue As String
'Téléchargement du fichier sur serveur ftp
DownloadFile strHote, strLogin, strMotDePasse, strFichier, GetTemporyFolderPath & strFichier
'Lecture du fichier téléchargé
intNumeroFichier = FreeFile    ' Lit le numéro de fichier inutilisé.
Open GetTemporyFolderPath & strFichier For Input As #intNumeroFichier 'ouvert en lecture
    While Not EOF(intNumeroFichier)
        Input #intNumeroFichier, strValeurLue
        ['Feuil1'!A1] = strValeurLue 'Inscription de la valeur lue en A1 de Feuil1
    Wend
Close #intNumeroFichier 'Fermeture du fichier
'Suppression du fichier temp
Kill GetTemporyFolderPath & strFichier
'MsgBox "ok"
End Sub
Sub RestitutionFTP() 
     
     intNumeroFichier = FreeFile '1er numéro libre
     Open GetTemporyFolderPath & strFichier For Output As #intNumeroFichier
     Print #intNumeroFichier, ['Feuil1'!A1] ' écrit dans le fichier
     Close #intNumeroFichier
     
     UploadFile strHote, strLogin, strMotDePasse, GetTemporyFolderPath & strFichier, strFichier
'If UploadFile(strHote, strLogin, strMotDePasse, GetTemporyFolderPath & strFichier, strFichier) Then _
    MsgBox "Fichier uploadé"

'Suppression du fichier temp
Kill GetTemporyFolderPath & strFichier
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 UploadFile(ByVal HostName As String, _
 ByVal UserName As String, _
    ByVal Password As String, _
    ByVal LocalFileName As String, _
    ByVal RemoteFileName As String) As Boolean
 
    Dim FTP As Inet

    Set FTP = New Inet
    With FTP
        .Protocol = icFTP
        .RemoteHost = HostName
        .UserName = UserName
        .Password = Password
        .Execute .URL, "Put " + LocalFileName + " " + RemoteFileName
        Do While .StillExecuting
            DoEvents
        Loop
        UploadFile = (.ResponseCode = 0)
    End With
Set FTP = Nothing
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

Je ne comprends pas bien ou ça "bug" sinon, tu me tiens au courant.
As tu coché la référence Microsoft Internet Transfert Control?
Déclenche la macro en tapant sur la touche F8, jusqu'au bug et dit moi ou ça bloque réellement.
@+

PS Peux tu mettre les balises code dans tes messages. Merci

 

[klorane]

Re : Un truc un peut tordu!

Bonjour Fred!

J'ai lancé par F8 la macro acquisition.

Dans Function DownloadFile ligne :

Dim FTP As Inet

(FTP as Inet : se met bleu foncé et message suivant : erreur de compilation -Type défini par l'utilisateur non défini)

Voilà ou ça bloque

En esperant que t'es la solution ;-)

Bonne journée et encore merci pour ton aide.

Klorane

 

[fred65200]

Re : Un truc un peut tordu!

bonjour

il te faut ajouter une référence à Microsoft Transfert Internet Control
si tu n'as pas cette référence recherche MSINET.OCX sur ton PC
ERREUR --> ("C:\Windows\System32\msinfo32.exe") <-- ERREUR avec le bouton Parcourir.
Si elle n'est pas sur ton PC, télécharge la (Google est ton ami)

Grossière erreur de copier coller de ma part, "C:\Windows\System32\MSINET.OCX" est le bon fichier, je corrige les posts précédents

@+

 

[klorane]

Re : Un truc un peut tordu!

En effet Fred t'as bien épuré la mixture ;-)

Par contre toujours le meme message pour : Dim FTP As Inet

Je garde la version "Presse purée" ;-)

Klorane

 

[klorane]

Re : Un truc un peut tordu!

J'ai télechargé MSinet.ocx

j'ai mëme fait : regsvr32 C:\Windows\System32\MSINET.OCX pour l'inclure ds le registre

Y a t'il autre chose a faire?

Klorane

 

[fred65200]

Re : Un truc un peut tordu!

re

dans vba outils / références, tu coches Microsoft Transfert Internet Control.
@+