Import d'un fichier XML via un lien web par un module VBA
Bonjour à tous,
Voici le contexte :
- Un lien de la forme "http://siteweb/blablabla" (pas d'extension) est généré par un logiciel pour exporter des données depuis un fichier XML hébergé sur le web avec un lien dynamique vers excel, c'est à dire qu'en actualisant les données sur le fichier excel, si des modifications sont effectuées sur le logiciel web alors les données sur excel seront mises à jour à leur tour.
- Le lien est collé dans une cellule sur un fichier excel (Fichier "Launcher", feuille "Générateur", cellule disons "A1")
- L'utilisateur clique sur un bouton ce qui ouvre un fichier, sélectionne la bonne feuille et importe les données depuis le lien XML dans la cellule "A1".
Pour la partie programmation :
- Aucun problème pour le bouton, l'ouverture du fichier, la sélection de la bonne feuille et la sélection de la cellule "A1".
- Par contre, impossible de trouver comment faire fonctionner la macro pour générer les données à partir du lien.
- J'utilise les variables suivantes :
Dim XMLSoc As String 'Stockage du lien récupéré
Dim Record As String 'Nom de la requête pour éviter les doublons à chaque import
("record" est le nom de base du fichier xml à importer, dans la variable j'ai donc "record [PERIODE]" où [PERIODE] est actualisé selon la date du fichier)
Autres informations :
- Je ne peux pas partager le fichier ou le lien car toutes les informations contenues dedans sont confidentielles, je peux cependant mettre des captures d'écran modifié si cela s'avèrerait nécessaire.
- J'ai écumer les sites internet et j'ai tester une bonne dizaine de solutions sans succès, dont le classique enregistreur de macro avec de multiples modifications, sans succès également. J'ai réussi à créer un début de code qui génère la requête mais celle-ci est vide et les données ne peuvent donc pas être importées.
Merci d'avance pour votre aide,
Bonne soirée,
Killian
PS : Je n'ai pas du tout un niveau expert en VBA
Bonjour Killian
Dans un premier temps, je te suggère de voir le document : https://www.excel-pratique.com/fr/telechargements/doc-excel/tutoriel-capturer-donnees-web-no451
Bonjour Gérald,
Merci pour ta réponse ! Je viens de parcourir le tuto et malheureusement ce n'est pas exactement le problème que je rencontre.. Sur excel j'arrive à intégrer à la main mes données sans problème, c'est pour programmer en VBA cet import que je galère...
Cordialement,
Killian
Killian,
Je n'ai pas bien saisi la nature de ton problème. En effet tu écris :
fichier XML hébergé sur le web avec un lien dynamique vers excel, c'est à dire qu'en actualisant les données sur le fichier excel, si des modifications sont effectuées sur le logiciel web alors les données sur excel seront mises à jour à leur tour.
En quoi aurais-tu alors besoin de VBA pour :
générer les données à partir du lien.
?
C'était pour contextualiser ce que je fait aujourd'hui à la main.
Le but de la macro est de récupérer un lien dans une cellule au format texte, d'aller sur une feuille determinée et de générer le tableau à partir du lien récupéré.
En fait j'ai plusieurs dizaine de société à un lien différent issu de la compta et plutôt que de les faire un par un je voulais tout coller dans une feuille et lancer la macro qui générera chaque tableau.
J'espère que c'est plus clair.
Merci à vous,
Killian
Bonjour Killian
Si tu ne peux partager ton fichier EXCEL "Launcher", peux-tu partager le le VBA déclenché l'utilisateur lorsqu'il clique sur le bouton ?
Bonsoir Gérard, j'essaye de vous partager ça d'ici demain soir, je m'arrangerai pour retirer les informations confidentielles pour vous livrer un fichier :)
OK Killian
Bonsoir Gérard,
Comme convenue voici les fichiers :)
Encore merci pour votre aide.
Bonne soirée,
Killian
OK Killian,
Je regarde tout ça et te donne des nouvelles,
Killian,
Malgré ce que tu a communiqué, j'ai plusieurs interrogations sur le process que tu cherches à mettre en place et, compte tenu de l'impossibilité que j'ai de pouvoir accéder au serveur XML utilisé, j'avoue m'interroger sur ma capacité à t'apporter l'aide que tu attends.
Ce que j'ai compris à partir des éléments envoyés :
- Pour une série de plusieurs dizaines de sociétés, tu dois générer un classeur (un par société ?)
- Les données à faire figurer dans un classeur 'Société' sont récupérées au format XML (à périodicité mensuelle ?).
- Pour chaque période, les données sont transformées et importées dans un tableau structuré au moyen d'une requête Power Query utilisant une URL (particulière à chaque société ?)
- Le tableau structuré est placé dans une feuille spécifique (une feuille par mois ?).
Telle que tu l'as communiquée, la macro 'Button_GO_Click' activée dans 'Launcher' correspond d'assez loin à ce que j'ai compris car :
- Le classeur cible est dénommé par au moyen d'une valeur fixe (NameFich).
- La période (mensuelle ?) n'est pas utilisée dans la requête PQ.
Bonsoir Gérard,
C'est exactement ça.
Pour le nom du classeur cible j'ai simplifier pour concentrer le code uniquement sur la partie requête et import des données. La macro actuelle récupère évidement le nom de la société (dans une boucle), vérifie l'existence de la feuille du mois (202110 par ex) et si elle n'existe pas elle est créée, sinon activée. Dans le code j'ai juste mis un nom pour l'exemple.
Chaque mois nous récupérons un lien XML par société, les liens sont mis dans un tableau, le rôle de la macro est pour chaque ligne d'ouvrir le classeur de la société, d'activer la feuille du mois, et d'importer les données.
Pour que ce soit peut être plus parlant voici ce que je réalise aujourd'hui à la main :
1.
2.
3.
4.
Voici le code obtenu avec l'enregistreur de macro :
ActiveWorkbook.Queries.Add Name:="record", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Xml.Tables(Web.Contents(""https://blablabla""))," & Chr(13) & "" & Chr(10) _
& " Table0 = Source{0}[Table]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Table0,{{""numero"", Int64.Type}, {""libelle"", type text}, {""debit_"", type text}, {""credit_"", type text}, {""solde_""" & _
", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=record;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [record]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "record"
.Refresh BackgroundQuery:=False
End With
Dans le résultat final : tout à droite de la fenêtre dans la liste des requêtes je souhaiterais appeler la requête "record 202110" par exemple.
L'autre soucis étant de remplacer le lien écrit en "brut" par une variable contenant ce lien..
Mon problème étant toujours le même....... Comment coder ça ?
Merci de votre patience et de votre aide,
Bonne soirée et au plaisir de vous lire,
Killian
Bonsoir Killian,
Avec les derniers éléments fournis, les choses sont beaucoup plus claires pour moi.
Je te propose d'amender ton code VBA de la façon suivante :
Private Sub Button_GO_Click()
Dim Chemin As String
Chemin = ThisWorkbook.Path
Dim NameFich As String
NameFich = "Fichier-reception.xlsm"
Dim XMLSoc As String
XMLSoc = Sheets(1).Cells(5, 11)
Dim NameFeuil As String
NameFeuil = "202110"
'Place de la boucle sur les sociétés
'Etape 1 : Ouverture du fichier de la société
Dim oWB As Workbook, oSheet As Worksheet
Application.ScreenUpdating = False
Set oWB = Workbooks.Open(Chemin & "\" & NameFich)
'Place de la récupération de la période avec création (ou non) de la feuille du mois
Set oSheet = oWB.Worksheets(NameFeuil)
LoadDataInListObject XMLSoc, oSheet, oWB
oWB.Close True
Set oWB = Nothing
Set oSheet = Nothing
End Sub
Sub LoadDataInListObject(zURL As String, zSheet As Worksheet, zWB As Workbook)
Dim oLO As ListObject, oPQ As WorkbookQuery, oQT As QueryTable
Dim sSource As String, sFormula As String
Dim sSQL As String
Dim sTblName As String, sCnxName As String
sTblName = "tbl_" & zSheet.Name 'On compose le nom de la requête
sCnxName = "cnx_" & zSheet.Name 'On compose le nom de la table cible
'Si la requête ou la table cible existe les supprime
On Error Resume Next
Set oPQ = zWB.Queries(sCnxName)
If Not oPQ Is Nothing Then
oPQ.Delete
End If
Set oLO = zSheet.ListObjects(sTblName)
If Not oLO Is Nothing Then
oLO.Delete
End If
On Error GoTo 0
'On compose la source de la connexion
sSource = "Xml.Tables(Web.Contents(""" & zURL & """))," & Chr(13) & "" & Chr(10) _
& " Table0 = Source{0}[Table]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Table0,{{""numero"", Int64.Type}, {""libelle"", type text}, {""debit_"", type text}, {""credit_"", type text}, {""solde_""" & _
", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
'On compose la formule de connexion
sFormula = "let" & Chr(13) & Chr(10) & " Source = " & sSource
'On crée la connexion power query
Set oPQ = zWB.Queries.Add(sCnxName, sFormula)
'On compose la source de la table cible
sSource = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sCnxName
'On crée la table cible
Set oLO = zSheet.ListObjects.Add(xlSrcExternal, sSource, True, xlGuess, zSheet.Range("$A$1"))
'On affecte la QueryTable
Set oQT = oLO.QueryTable
'On paramètre la QueryTable
With oQT
'On affecte le nom de la table
.ListObject.DisplayName = sTblName
'On affecte la commande SQL de récupération des données de la connexion
.CommandType = xlCmdSql
sSQL = "SELECT * FROM [" & sCnxName & "]"
.CommandText = Array(sSQL)
'On reprend les autres paramètres présents dans la macro générée
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub
Du fait que je ne peux le tester, je ne garantis pas qu'il va fonctionner tel quel. Je te propose de l'implémenter et de me faire un retour.
Bonjour Killian,
Peux-tu fournir tout le code VBA de la procédure telle que tu l'as implémentée ?
Bonjour Gérard,
Et voici :
Private Sub Button_GO_Click()
Dim NbSoc As Integer
NbSoc = Sheets("Data").Cells(8, 5)
Dim NameSoc As String
Dim CodeSoc As String
Dim XMLSoc As String
Dim ResultSoc As Double
Dim Chemin As String
Chemin = ThisWorkbook.Path
Dim NameFich As String
Dim ws As Worksheet
Dim NbMois As Integer
NbMois = 0
Dim NameFeuil As String
For i = 1 To NbSoc
'Etape 0 : Récupération des informations et initialisation des variables
NameSoc = Sheets("Générateur").Cells(i + 10, 3)
CodeSoc = Sheets("Générateur").Cells(i + 10, 2)
XMLSoc = Sheets("Générateur").Cells(i + 10, 5)
ResultSoc = Sheets("Générateur").Cells(i + 10, 13)
NameFich = "Tableau de Bord - " & CodeSoc & ".xlsm"
NameFeuil = "BG 202110" 'A automatiser
'Etape 1.1 : Ouverture du fichier de la société
Application.ScreenUpdating = False
Dim oWB As Workbook, oSheet As Worksheet
Set oWB = Workbooks.Open(Chemin & "\" & NameFich)
'Etape 1.2 :Place de la récupération de la période avec création (ou non) de la feuille du mois
Set oSheet = oWB.Worksheets(NameFeuil)
'Etape 1.3 : Import des données
LoadDataInListObject XMLSoc, oSheet, oWB
oWB.Close True
Set oWB = Nothing
Set oSheet = Nothing
Next
End Sub
Sub LoadDataInListObject(zURL As String, zSheet As Worksheet, zWB As Workbook)
Dim oLO As ListObject, oPQ As WorkbookQuery, oQT As QueryTable
Dim sSource As String, sFormula As String
Dim sSQL As String
Dim sTblName As String, sCnxName As String
sTblName = "tbl_" & zSheet.Name 'On compose le nom de la requête
sCnxName = "cnx_" & zSheet.Name 'On compose le nom de la table cible
'Si la requête ou la table cible existe les supprime
On Error Resume Next
Set oPQ = zWB.Queries(sCnxName)
If Not oPQ Is Nothing Then
oPQ.Delete
End If
Set oLO = zSheet.ListObjects(sTblName)
If Not oLO Is Nothing Then
oLO.Delete
End If
On Error GoTo 0
'On compose la source de la connexion
sSource = "Xml.Tables(Web.Contents(""" & zURL & """))," & Chr(13) & "" & Chr(10) _
& " Table0 = Source{0}[Table]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Table0,{{""numero"", Int64.Type}, {""libelle"", type text}, {""debit_"", type text}, {""credit_"", type text}, {""solde_""" & _
", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
'On compose la formule de connexion
sFormula = "let" & Chr(13) & Chr(10) & " Source = " & sSource
'On crée la connexion power query
Set oPQ = zWB.Queries.Add(sCnxName, sFormula)
'On compose la source de la table cible
sSource = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & sCnxName
'On crée la table cible
Set oLO = zSheet.ListObjects.Add(xlSrcExternal, sSource, True, xlGuess, zSheet.Range("$A$1"))
'On affecte la QueryTable
Set oQT = oLO.QueryTable
'On paramètre la QueryTable
With oQT
'On affecte le nom de la table
.ListObject.DisplayName = sTblName
'On affecte la commande SQL de récupération des données de la connexion
.CommandType = xlCmdSql
sSQL = "SELECT * FROM [" & sCnxName & "]"
.CommandText = Array(sSQL)
'On reprend les autres paramètres présents dans la macro générée
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub
Killian,
A priori, je ne vois pas ce qui coince dans ton code.
Eventuellement 2 pistes :
- Vérifies que dans la feuille cible ne contient pas de tableau structuré en A1. Si oui, supprime le.
- Le nom de la feuille comportant un espace, je te suggère de remplacer 2 lignes de la procédure appelée de la façon suivante :
Sub LoadDataInListObject(zURL As String, zSheet As Worksheet, zWB As Workbook)
Dim oLO As ListObject, oPQ As WorkbookQuery, oQT As QueryTable
Dim sSource As String, sFormula As String
Dim sSQL As String
Dim sTblName As String, sCnxName As String
sTblName = "tbl_" & Replace(zSheet.Name, " ", "_") 'On compose le nom de la requête
sCnxName = "cnx_" & Replace(zSheet.Name, " ", "_") 'On compose le nom de la table cible
Bonjour Killian,
Damned !
Afin de pouvoir partager des informations plus sensibles, je te propose de poursuivre en message privé.
Peux-tu m'envoyer un simple message privé auquel je te répondrai ?