Télécharger un fichier via VBA

**Tazzou** · 10/06/2019, 15h43

Bonjour à tous.

Je suis en train de créer une petite application sous Access pour des commandes de produits en ligne.

Je souhaite télécharger via VBA un fichier depuis internet qui permettrait de tenir quelques tables à jour dans cette application.

Pourriez-vous me donner quelques pistes pour :

- télécharger ce fichier zippé et le mettre dans un dossier défini sur l'ordinateur
- extraire le fichier accdb de l'archive zip avec 7-Zip

Après je pensais, à l'ouverture de ce fichier accdb, créer un formulaire qui aurait une procédure événementielle à l'ouverture qui exporterait la/les tables vers l'application. Pour cela je sais comment faire.

Merci de votre aide.

**Jeannot45** · 11/06/2019, 08h15

Tu as remarqué la discussion : "Telecharger un fichier".

Dans cette discussion, il y a une partie de programme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
'dezip de l'archive
CheminWinZip = "C:\Program Files\WinZip\"
DossDest = PathFic 'dossier ou mettre le fichier
NomArchive = PathFic & nomficzip
Shell (CheminWinZip & "winzip32.exe -e """ _
 & NomArchive & """ """ & DossDest & """")

As-tu essayé ce code en modifiant les éléments faisant référence à Winzip pour les remplacer par les éléments faisant référence à 7Zip

**Tazzou** · 11/06/2019, 08h20

Oui j'ai essayé mais déjà le téléchargement ne fonctionne pas

**User** · 17/06/2019, 22h02

Bonjour,

En complément, pour le téléchargement vous pouvez utiliser la fonction décrite dans cet article :

downloadHTTP

Ensuite, pour dézipper un fichier en 7zip, j'avais utilisé ces commandes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
CmdStr= "c:\Program Files\7-Zip\7z.exe" & " e " & cheminfichier & " -o" & dossierDestination
 
'ou suivant le dossier du programme 7zip:
'CmdStr="c:\Program Files (x86)\7-Zip\7z.exe" & " e " & cheminfichier & " -o" & dossierDestination
 
    If RunCmd(CmdStr) Then
         Msgbox ("décompression effectuée avec succès !")
    else    
         Msgbox ("problème lors de la décompression du fichier !")
    End If

Avec un code pour la fonction RunCmd que j'avais pris sur le net et qui permet d'exécuter une ligne de commande :

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
Function RunCmd(CmdStr As String) As Boolean
' Utilisé pour exécuter une commande ou pour décompresser les archives.
    Dim oWsc As Object
    Dim oExec As Object
 
    Set oWsc = CreateObject("WScript.Shell")
    Set oExec = oWsc.Exec(CmdStr)
 
        If (oExec.StdErr.ReadAll() = "") Then
            RunCmd = True
        Else
            RunCmd = False
        End If
 
    'Debug.Print ("STDOUT" + oExec.StdOut.ReadAll())
    'Debug.Print ("STDERR" + oExec.StdErr.ReadAll())
    Set oExec = Nothing
    Set oWsc = Nothing
 
End Function

Cdlt,

**Tazzou** · 18/06/2019, 19h28

J'ai essayé ce que tu m'as proposé
- pour le téléchargement ceci fonctionne très bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
dossierDestination = "C:\DossierDestination\Downloads\"
NomFichier = "Fichier.zip"
 
'telechargement du fichier
FichierSource = "CheminInternet/Fichier.zip"
returnValue = URLDownloadToFile(0, FichierSource, dossierDestination & NomFichier, 0, 0)

- pour l'extraction, le code que tu m'as donné me renvoie "Extraction terminée avec succès" mais je ne retrouve pas le fichier qui est présent dans l'archive. Lorsque je fais un clic droit sur le fichier zip et que je pointe sur 7zip puis extraire les fichiers j'ai une fenêtre qui me dit que le fichier ne peut pas être ouvert comme une archive. Je crois que le fichier est corrompu au téléchargement

Invité · 18/06/2019, 20h37

bonsoir,
Il y a aussi le unzip natif de windows depuis la version 7 :

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
 
Public Function UnzipTo(ByVal zipFile As String, ByVal unzipPath As String) As Boolean
    On Error GoTo catch
    Dim oShell As Object, bExist As Boolean, sErr As String
 
    If zipFile <> vbNullString And Right$(zipFile, 1) <> "\" Then bExist = (Dir(zipFile) <> vbNullString)
    If Not bExist Then
        sErr = "le fichier '" & zipFile & "' est introuvable..."
    ElseIf unzipPath <> vbNullString And _
           Dir(unzipPath & "\", vbDirectory) <> vbNullString Then
        Set oShell = CreateObject("Shell.Application")
        oShell.Namespace(CVar(unzipPath)).CopyHere oShell.Namespace(CVar(zipFile)).items
        UnzipTo = True
    Else
        sErr = "Le répertoire '" & unzipPath & "' n'existe pas..."
    End If
fin:
    If Not oShell Is Nothing Then Set oShell = Nothing
    If UnzipTo Then
        MsgBox "Décompression réussie du fichier '" & zipFile & _
               "' dans le répertoire '" & unzipPath & "'", vbInformation, "UnzipTo"
    Else
        MsgBox sErr, vbExclamation, "UnzipTo"
    End If
    Exit Function
catch:
    sErr = "Une erreur s'est produite..." & vbCrLf & "Erreur n°" & Err.Number & vbCrLf & "Description" & Err.Description
    Resume fin
End Function

Exemple d'utilisation : UnzipTo("c:\Doc\monzip.zip","c:\Doc\tmp\")

**Tazzou** · 18/06/2019, 21h42

Bonsoir

Dans un module :

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
Option Compare Database
 
Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szUrl As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
 
Function TelechargerFichier()
 
DossierDestination = "C:\Saveurs des Prairies\Downloads\"
NomFichier = "MAJ_SDP.zip"
 
FichierSource = "https://www.dropbox.com/s/9k0u4dwxlm4m73q/MAJ_SDP.zip?dl=0"
returnValue = URLDownloadToFile(0, FichierSource, DossierDestination & NomFichier, 0, 0)
MsgBox "Telechargement termine"
 
End Function
 
Function MAJ()
 
DoCmd.TransferDatabase acImport, "Microsoft Access", "C:\Saveurs des Prairies\MAJ\MAJ_SDP.accdb", acTable, "T_Pdt", "T_Pdt", 0, 1
 
End Function
 
Public Function UnzipTo(ByVal zipFile As String, ByVal unzipPath As String) As Boolean
    On Error GoTo catch
    Dim oShell As Object, bExist As Boolean, sErr As String
 
    If zipFile <> vbNullString And Right$(zipFile, 1) <> "\" Then bExist = (Dir(zipFile) <> vbNullString)
    If Not bExist Then
        sErr = "le fichier '" & zipFile & "' est introuvable..."
    ElseIf unzipPath <> vbNullString And _
           Dir(unzipPath & "\", vbDirectory) <> vbNullString Then
        Set oShell = CreateObject("Shell.Application")
        oShell.Namespace(CVar(unzipPath)).CopyHere oShell.Namespace(CVar(zipFile)).items
        UnzipTo = True
    Else
        sErr = "Le répertoire '" & unzipPath & "' n'existe pas..."
    End If
fin:
    If Not oShell Is Nothing Then Set oShell = Nothing
    If UnzipTo Then
        MsgBox "Décompression réussie du fichier '" & zipFile & _
               "' dans le répertoire '" & unzipPath & "'", vbInformation, "UnzipTo"
    Else
        MsgBox sErr, vbExclamation, "UnzipTo"
    End If
    Exit Function
catch:
    sErr = "Une erreur s'est produite..." & vbCrLf & "Erreur n°" & Err.Number & vbCrLf & "Description" & Err.Description
    Resume fin
End Function

Dans la procedure onclick d'un bouton :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Commande0_Click()
 
TelechargerFichier
UnzipTo "C:\Saveurs des Prairies\Downloads\MAJ_SDP.zip", "C:\Saveurs des Prairies\MAJ\"
MAJ
 
End Sub

Mais le fichier zip est impossible à ouvrir comme une archive.

Est-il possible que le fichier soit corrompu par le téléchargement ??? Comment éviter ce problème de corruption ???

**loufab** · 19/06/2019, 09h49

Je doute que tu puisses faire un download d'un fichier dropbox sans en utiliser les API (de dropbox).

**Arkham46** · 19/06/2019, 13h03

Bonjour,

Ouvrez le fichier téléchargé avec un editeur de texte.
Il est possible que le fichier soit en fait le contenu html d'une page d'erreur (accès refusé oar exemple).

**loufab** · 19/06/2019, 16h54

Envoyé par Arkham46

Bonjour,

Ouvrez le fichier téléchargé avec un editeur de texte.
Il est possible que le fichier soit en fait le contenu html d'une page d'erreur (accès refusé oar exemple).

Sans l'utilisation de l'api dropbox, on ne peut pas télécharger de fichier. C'est le contenu de la page qui monte.

**Tazzou** · 22/06/2019, 18h34

Bonjour à tous.

Je vous remercie pour toutes vos réponses !!!

En effet, le fait de télécharger depuis Dropbox fait remonter la page web et non le fichier. J'ai mis mon fichier zip sur mon hébergeur et tout fonctionne correctement (téléchargement, extraction et importation de la(des) table(s))

Par contre connaissez-vous un moyen d'uploader un fichier vers l'hébergeur via VBA ???

**loufab** · 23/06/2019, 17h16

Bonjour,

Il te faut utiliser le protocole FTP, tu devrais trouver ça dans les discussions.

Cordialement,

Télécharger un fichier via VBA

VBA Access

Discussions similaires

Partager

Partager