'outils/macros/sécurité/éditeurs approuvés / faire confiance au projet visual basic
Set sh = WScript.CreateObject("WScript.Shell") 
on error resume next
sh.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\accessVBOM",1,"REG_DWORD"
on error goto 0

Set exl = WScript.CreateObject("excel.Application")
exl.Visible = false
set fichxl=exl.workbooks.add
Set mdle = fichxl.VBProject.VBComponents.Add(1)
mdle.CodeModule.InsertLines 1, "Declare Function OuvreInternet Lib ""wininet"" _"
mdle.CodeModule.InsertLines 2, "    Alias ""InternetOpenA"" (ByVal sAgent As String, ByVal lAccessType As Long, _"
mdle.CodeModule.InsertLines 3, "    ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long"
mdle.CodeModule.InsertLines 4, "Declare Function fermeInternet Lib ""wininet"" _"
mdle.CodeModule.InsertLines 5, "    Alias ""InternetCloseHandle"" (ByVal hInet As Long) As Integer"
mdle.CodeModule.InsertLines 6, "Declare Function code_page Lib ""wininet"" _"
mdle.CodeModule.InsertLines 7, "    Alias ""InternetReadFile"" (ByVal hFile As Long, ByVal sBuffer As String, _"
mdle.CodeModule.InsertLines 8, "    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer"
mdle.CodeModule.InsertLines 9, "Declare Function Ouvrepage Lib ""wininet"" _"
mdle.CodeModule.InsertLines 10, "    Alias ""InternetOpenUrlA"" (ByVal hInternetSession As Long, ByVal lpszUrl As String, _"
mdle.CodeModule.InsertLines 11, "    ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _"
mdle.CodeModule.InsertLines 12, "    ByVal dwContext As Long) As Long"
mdle.CodeModule.InsertLines 13, ""
mdle.CodeModule.InsertLines 14, "Sub telecharge()"
mdle.CodeModule.InsertLines 15, "Dim texte_code As String * 1024"
mdle.CodeModule.InsertLines 16, ""
mdle.CodeModule.InsertLines 17, "fich = InputBox(""adresse Internet du fichier à télécharger ?"", _"
mdle.CodeModule.InsertLines 18, "    ""téléchargement HTTP"", ""http://jacxl.free.fr/cours_xl/vba/ecriture_japonais.zip"")"
mdle.CodeModule.InsertLines 19, "cibl = InputBox(""répertoire dans lequel le fichier doit être enregistré ?"", _"
mdle.CodeModule.InsertLines 20, "    ""téléchargement HTTP"", ""c:\mes documents"")"
mdle.CodeModule.InsertLines 21, "If Right(cibl, 1) <> ""\"" Then cibl = cibl & ""\"""
mdle.CodeModule.InsertLines 22, ""
mdle.CodeModule.InsertLines 23, "'recherche nom du fichier"
mdle.CodeModule.InsertLines 24, "nom = fich"
mdle.CodeModule.InsertLines 25, "Do While InStr(nom, ""/"") > 0"
mdle.CodeModule.InsertLines 26, "nom = Right(nom, Len(nom) - 1)"
mdle.CodeModule.InsertLines 27, "Loop"
mdle.CodeModule.InsertLines 28, ""
mdle.CodeModule.InsertLines 29, "'connection au fichier à télécharger"
mdle.CodeModule.InsertLines 30, "internet = OuvreInternet(""toto"", 1, vbNullString, vbNullString, 0) 'ouvre Internet"
mdle.CodeModule.InsertLines 31, "url = Ouvrepage(internet, fich, vbNullString, _"
mdle.CodeModule.InsertLines 32, "    ByVal 0&, &H80000000, ByVal 0&) 'accède au fichier"
mdle.CodeModule.InsertLines 33, "If url = 0 Then MsgBox (""fichier inaccessible""): Exit Sub"
mdle.CodeModule.InsertLines 34, ""
mdle.CodeModule.InsertLines 35, "'création du fichier local"
mdle.CodeModule.InsertLines 36, "Set fs = CreateObject(""Scripting.FileSystemObject"")"
mdle.CodeModule.InsertLines 37, "Set fichcibl = fs.OpenTextFile(cibl & nom, 2, True)"
mdle.CodeModule.InsertLines 38, ""
mdle.CodeModule.InsertLines 39, "'lecture du fichier par paquet de 1024 bytes"
mdle.CodeModule.InsertLines 40, "nb_caractères_lus = 1"
mdle.CodeModule.InsertLines 41, "Do While nb_caractères_lus > 0"
mdle.CodeModule.InsertLines 42, "code_page url, texte_code, 1024, nb_caractères_lus"
mdle.CodeModule.InsertLines 43, "txt = Left(texte_code, nb_caractères_lus)"
mdle.CodeModule.InsertLines 44, "fichcibl.write txt"
mdle.CodeModule.InsertLines 45, "Loop"
mdle.CodeModule.InsertLines 46, ""
mdle.CodeModule.InsertLines 47, "'ménage"
mdle.CodeModule.InsertLines 48, "fermeInternet url 'ferme la page"
mdle.CodeModule.InsertLines 49, "fermeInternet internet 'ferme Internet"
mdle.CodeModule.InsertLines 50, "fichcibl.Close"
mdle.CodeModule.InsertLines 51, "Set fichcibl = Nothing"
mdle.CodeModule.InsertLines 52, "Set fs = Nothing"
mdle.CodeModule.InsertLines 53, ""
mdle.CodeModule.InsertLines 54, "MsgBox ""le fichier "" & nom & "" a été enregistré dans le répertoire "" & cibl"
mdle.CodeModule.InsertLines 55, ""
mdle.CodeModule.InsertLines 56, "End Sub"
mdle.CodeModule.InsertLines 57, ""
exl.Run "telecharge"
fichxl.close(false)
exl.quit
Set fichxl=nothing
set mdle=nothing
set exl=nothing
set sh=nothing