Créer une page HTLM et l'envoyer sur le WEB

**Crachover** · 14/07/2018, 09h50

Bonjour,

J'aimerais créer un fichier HTML reprenant certaines valeurs de mes feuilles avec mise en page et l'envoyer sur le Web via FTP...

J'ai trouvé des morceaux de codes, mais je n'y arrive pas...

Pour créer un fichier HTML

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
' --- Dans un module standard: ---
 
Option Explicit
 
Public Collect As Collection
Public MaVariable As String
 
 
Sub Test()
    Dim xFile As Integer
    Dim Cl As Classe1
    Dim LaPage As Object
 
    xFile = FreeFile
 
    Open "C:\CreationPage.html" For Output As xFile
        Print #xFile, "<HTML>"
        Print #xFile, "<HEAD>"
        Print #xFile, "<TITLE>Ma page de saisie</TITLE>"
        Print #xFile, "</HEAD>"
 
        Print #xFile, "<FORM>" & _
            "<input type='text' size='10' name='autre'><br>" & _
            "<INPUT type=button name='Bouton1' value='Validez'>" & _
            "</FORM>" & _
            "</BODY></HTML>"
        Print #xFile, "</BODY>"
        Print #xFile, "</HTML>"
    Close xFile
 
 
    Set Collect = New Collection
    Set LaPage = CreateObject("InternetExplorer.Application")
 
    Set Cl = New Classe1
    Set Cl.IE = LaPage
    Collect.Add Cl
 
    With LaPage
        .AddressBar = False
        .MenuBar = False
        .StatusBar = False
        .Toolbar = False
        .Visible = True
        .Width = 400
        .Height = 300
        .navigate "C:\CreationPage.html"
 
        Do Until .readyState = 4
            DoEvents
        Loop 'attend la fin du chargement
    End With
 
End Sub

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
' --- Dans un module de classe nommé Classe1 ---
 
Option Explicit
 
Public WithEvents IE As InternetExplorer
Dim WithEvents Bouton As HTMLInputElement
Dim MaPageHtml As HTMLDocument
 
 
Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Set MaPageHtml = IE.document
 
    'pour cet exemple le bouton est le 2eme objet "input" de la page... Item(1)
    Set Bouton = MaPageHtml.getElementsByTagName("input").Item(1)
End Sub
 
 
Private Function Bouton_onclick() As Boolean
    'Récupère le contenu de la zone de saisie dans la page html
    MaVariable = MaPageHtml.getElementsByTagName("input").Item(0).Value
 
    MsgBox MaVariable
    IE.Quit
End Function

Pour l'envoyer sur le Web

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
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 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 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.dll" (ByVal hInet As Long) As Integer
 
 
Sub ftp()
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)
Dim Start As Single
 
'PARAMETRES************************
fichier = "D:\chemin de ton fichier à transferer"
login = "login de ton ftp"
mot_passe = "mot de passe"
rép = "/www/dossier ou transferer le fichier sur ftp"
bin_asc = &H2 '(&H1 ascii, &H2 binaire)
Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************
 
'lancer le transfert
internet_ok = InternetOpen("PutFtpFile", 1, "", "", 0)
If internet_ok = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
ftp_ok = InternetConnect(internet_ok, "ftp.nom de ton ftp.fr", 21, login, mot_passe, 1, Mode, 0)
If ftp_ok = 0 Then
MsgBox "connection impossible"
Exit Sub
End If
sélect_rép = FtpSetCurrentDirectory(ftp_ok, rép)
If sélect_rép = 0 Then
MsgBox "impossible de trouver le répertoire "
Exit Sub
End If
 
'nom du fichier sans le chemin
nomfich = fichier
Do While InStr(nomfich, "\") > 0
nomfich = Right(nomfich, Len(nomfich) - InStr(nomfich, "\"))
Loop
 
'transférer le fichier
succès = FtpPutFile(ftp_ok, fichier, nomfich, bin_asc, 0)
If succès Then
résult = nomfich & " a été transféré "
Else
résult = nomfich & " n'a pas pu être transféré"
End If
 
'fermer les pointeurs, ménage
InternetCloseHandle ftp_ok
InternetCloseHandle internet_ok
 
'annoncer le résultat de l'opération
If résult <> "" Then
UserForm3.Label1 = résult
UserForm3.Show
'MsgBox résult
Else
UserForm3.Label1 = "aucun fichier transféré"
UserForm3.Show
 
'MsgBox "aucun fichier transféré"
End If
 
End Sub

Pourriez-vous m'aider ?

**Crachover** · 14/07/2018, 12h29

EDIT
J'ai trouvé le code pour enregistrer une feuille en HTML :-)

Il ne reste plus qu'à trouver comme la copier/remplacer en FTP...

**patricktoulon** · 16/07/2018, 10h07

Bonjour sous quelle forme les donnée du classeur devront etre envoyées

ensuite apprend a créer tes document en DOM du galerera beaucoup moins qu'en string surtout si il sagit de tableaux exel

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
Sub Test()
    xFile = FreeFile
    With CreateObject("htmlfile")
        .body.innerhtml = ""
        Set HTML = .createelement("HTML")
        Set head = .createelement("head")
        Set titre = .createelement("title"): titre.innerhtml = "Ma page de saisie"
 
        Set form = .createelement("FORM")
        Set input1 = .createelement("input"): input1.setattribute "size", 10: input1.setattribute "Name", "autre": input1.setattribute "Type", "texte"
        Set input2 = .createelement("input"): input2.setattribute "Name", "Bouton1": input2.setattribute "Type", "Button": input2.Value = "valider"
 
        head.appendchild (titre)
        HTML.appendchild (head)
        .body.appendchild (HTML)
        HTML.appendchild (form)
        form.appendchild (input1)
        form.appendchild (input2)
        Debug.Print .body.innerhtml
        Open "C:\CreationPage.html" For Output As xFile
        Print #xFile, .body.innerhtml
        Close xFile
    End With
End Sub

pour l'envoie en ftp tu a divers exemple sur le forum

**Crachover** · 17/07/2018, 17h42

Merci pour les renseignements, je vais y regarder :-)

Par contre, j'ai trouvé comment copier un fichier vers un FTP, voici le code et il fonctionne très bien. Maintenant, j'aimerais modifier ce code pour qu'il copie un fichier déjà présent dans un des répertoires du site vers un autre répertoire du même site.

Je m'explique : le code actuel, copie le fichier viewscorestv.htm présent dans le répertoire WEB de mon PC vers le répertoire scoreTV de mon site Internet, et cela fonctionne très bien :-)

J'aimerais maintenant que le code recopie le fichier viewscorestv.htm présent dans le répertoire scoreTV/empty dans le répertoire scoreTV et je n'y arrive pas, c'est surement avec FtpGetFile ou pas...

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
Sub ftp()
'transfère des fichiers du disque local vers un serveur ftp (upload, mode passif)
Dim Start As Single
 
'PARAMETRES************************
Fichier = ThisWorkbook.Path & "\WEB\viewscorestv.htm"
login = "******"
mot_passe = "***********"
rép = "/www/scoresTV/"
bin_asc = &H2 '(&H1 ascii, &H2 binaire)
Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************
 
'lancer le transfert
internet_ok = InternetOpen("PutFtpFile", 1, "", "", 0)
If internet_ok = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
ftp_ok = InternetConnect(internet_ok, "ftp.******.be", 21, login, mot_passe, 1, Mode, 0)
If ftp_ok = 0 Then
MsgBox "connection impossible"
Exit Sub
End If
sélect_rép = FtpSetCurrentDirectory(ftp_ok, rép)
 
If sélect_rép = 0 Then
MsgBox "impossible de trouver le répertoire"
Exit Sub
End If
 
'nom du fichier sans le chemin
nomfich = Fichier
Do While InStr(nomfich, "\") > 0
nomfich = Right(nomfich, Len(nomfich) - InStr(nomfich, "\"))
Loop
 
'transférer le fichier
succès = FtpPutFile(ftp_ok, Fichier, nomfich, bin_asc, 0)
If succès Then
'résult = nomfich & " a été transféré "
résult = " mise à jour [écran TV] effectuée "
Else
'résult = nomfich & " n'a pas pu être transféré"
résult = " mise à jour [écran TV] non effectuée ! "
End If
 
'fermer les pointeurs, ménage
InternetCloseHandle ftp_ok
InternetCloseHandle internet_ok
 
'annoncer le résultat de l'opération
If résult <> "" Then
'UserForm3.Label1 = résult
'UserForm3.Show
MsgBox résult
Else
'UserForm3.Label1 = "aucun fichier transféré"
'UserForm3.Show
 
MsgBox "aucun fichier transféré"
End If
 
End Sub

Merci pour votre aide :-)

**Crachover** · 18/07/2018, 19h02

J'ai trouvé... voici le code pour ceux qui en aurait besoin...

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
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 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 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 FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" ( _
ByVal hConnect 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
Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
 
Sub offline()
If Sheets("Variables").Range("Q13").Value = "Non" Then MsgBox "Bouton désactivé, contacté le concepteur pour activation !": Exit Sub
 
 
MonDossier = ThisWorkbook.Path & "\WEB"
MonDossier2 = ThisWorkbook.Path & "\WEB\empty"
 
        If Dir(MonDossier, vbDirectory) = "" Then
            MkDir MonDossier
        End If
        If Dir(MonDossier2, vbDirectory) = "" Then
            MkDir MonDossier2
        End If
 
 
 
'COPIE DU FICHIER EN LOCAL
'=========================
 
succès = False
 
 
'PARAMETRES************************
nom_fichier = "viewscorestv.htm"
Fichier = ActiveWorkbook.Path & "\WEB\empty\viewscorestv.htm"
login = "*******"
mot_passe = "*********"
rép = "/www/********/******/"
bin_asc = &H0 '(&H1 ascii, &H2 binaire, &H0 )
Mode = &H8000000 '(&H8000000 mode passif, 0 mode actif)
'**********************************
'Vérifier la connection à internet
InternetOK = InternetOpen("PutFtpFile", 1, "", "", 0)
If InternetOK = 0 Then
MsgBox "connection internet impossible"
Exit Sub
End If
'Vérifier l'accès ftp
Ftp_OK = InternetConnect(InternetOK, "ftp.*********.be", 21, login, mot_passe, 1, Mode, 0)
 
If Ftp_OK = 0 Then
MsgBox "connection FTP impossible"
 
Exit Sub
End If
'vérifier le dossier distant
Select_DossierDistant = FtpSetCurrentDirectory(Ftp_OK, rép)
If Select_DossierDistant = 0 Then
MsgBox "impossible de trouver le répertoire distant "
Exit Sub
End If
 
    succès = FtpGetFile(Ftp_OK, nom_fichier, Fichier, False, 0, bin_asc, 0)
 
    If succès Then
    'Result = "Le fichier a été correctement récupéré "
    'MsgBox Result
    résult = "pas de fenêtre svp"
    Else
    Result = "Erreur FTP : le fichier n'a pas pu être récupéré "
    MsgBox Result
    End If
 
    'For i = 1 To 7
    'récupération des adresses des fichiers à récupérer sur le serveur
    'liste_fichier(i) = ThisWorkbook.Worksheets("Envoi FTP").Cells(10 + i, 1).Value
 
    'fichierlocal = cheminFichierSortie & "\" & liste_fichier(i)
    'FichierDistant = liste_fichier(i)
 
    'MsgBox "fichier local : " & fichierlocal
    'MsgBox "fichier distant : " & FichierDistant
 
    'transfert du fichier
    'succès = FtpGetFile(FtpOK, FichierDistant, fichierlocal, False, 0, FTP_TRANSFER_TYPE_ASCII, 0)
 
    'fin affichage fenêtre d'attente
    'Waitbox.Hide 'masque la waitbox
 
    'Application.Cursor = xlDefault 'remet le curseur par défaut
 
    'If succès Then
    'Result = "Le fichier " & nom_fichier & " a été correctement récupéré "
    'MsgBox Result
 
    'Else
    'Result = "Erreur FTP : le fichier " & nom_fichier & " n'a pas pu être récupéré."
    'MsgBox Result
    'ShowError ("GetFile: " & nom_fichier)
    'Exit Sub
    'End If
 
    'Next
 
 
    'fermer les pointeurs, ménage
    InternetCloseHandle Ftp_OK
    InternetCloseHandle Internet_OK
 
 
    End Sub

Créer une page HTLM et l'envoyer sur le WEB [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager