VBA Excel : Importer XML - xlDialogOpen

Résolu/Fermé

Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 - 25 sept. 2011 à 18:36
HardyPetit - 3 févr. 2015 à 17:12

Bonjour,

J'essaie vainement d'importer un fichier au format XML a l'aide d'une macro VBA dans Excel.

La fonction d'importation qui fonctionne est :

Workbooks.OpenXML Filename:= "D:\test\Reponses.xml", LoadOption:=xlXmlLoadImportToList

et afin de permettre à mes utilisateurs de pouvoir choisir leur fichier facilement, je souhaiterais passer par l'ouverture de la boite Excel d'ouverture de fichier (ou similaire).

J'ai donc tenté avec la fonction ci dessous :

encore:
FichierOk = Application.Dialogs(xlDialogOpen).Show
If Not FichierOk Then
MsgBox " Vous devez choisir un fichier"
GoTo encore
End If

Mais le résultat de l'importation n'est pas au format "Liste" tel que le génère le premier code que j'ai mentionné plus haut.
Il y a t il une solution pour effectuer cette importation à partir d'une boite "xldialogOpen" ou quelque chose dans le même style ?

Merci d'avance pour votre aide. !

A voir également:

Importer un fichier xml dans excel
Fichier rar - Guide
Liste déroulante excel - Guide
Fichier host - Guide
Fichier iso - Guide
Comment réduire la taille d'un fichier - Guide

8 réponses

Réponse 1 / 8

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
11 janv. 2013 à 16:29

Bonjour,

et en modifiant le début de la macro comme ceci ? :

NomFichierXML = Application.GetOpenFilename("Fichier XML (*.xml),*.xml", , "Choisir le fichier")
With ActiveSheet.QueryTables.Add(Connection:=NomFichierXML, Destination:=Range("A1"))
...
A+

Réponse 2 / 8

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
Modifié par pilas31 le 25/09/2011 à 23:03

Bonjour,

Peut-être en utilisant cette syntaxe :

NomFichierXML = Application.GetOpenFilename("Fichier XML (*.xml),*.xml", , "Choisir le fichier")

L'utilisateur fait le choix du fichier mais il n'est pas ouvert, c'est le chemin du fichier qui est retourné ici dans la variable NomFichierXML. Retourne FAUX si l'utilisateur ne fait pas de choix.

Il suffit ensuite d'ouvrir le fichier avec la syntaxe :
Workbooks.OpenXML Filename:= NomFichierXML

A tester

A+

Cordialement,

Réponse 3 / 8

Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
Modifié par Eaheru le 26/09/2011 à 09:07

Bonjour,
C'est parfait ! :) merci beaucoup pour ce coup de main.
La chose chose a savoir est que la variable NomFichierXML doit etre configurée en "Variant" puisque si l'utilisateur ne choisi pas de fichier il y a un retour booleen (vrai/faux)

NomFichierXML = Application.GetOpenFilename("Fichier XML (*.xml),*.xml", , "Choisir le fichier") 
Set wk2 = Workbooks.OpenXML(Filename:=NomFichierXML, LoadOption:=xlXmlLoadImportToList)

Une fois ce détail ajusté, ça marche impeccablement !
Encore Merci

Une question pour terminer complétement ma macro, est il possible d'ouvrir la fenêtre de choix du fichier XML dans un répertoire précis ? Cela faciliterait la vie de mes utilisateurs :)

Eaheru Messages postés 197 Date d'inscription mercredi 23 juin 2010 Statut Membre Dernière intervention 12 mars 2018 20
26 sept. 2011 à 09:16

Ok j'ai resolu de maniere triviale :) en ajoutant une ligne :

ChDir \\monchemin

juste avant l'appel de la fonction getopenfilename

Réponse 4 / 8

Jeremie
11 janv. 2013 à 15:32

Bonjour!

je vous présente mon problème:

j'ai un fichier excel contenant certaines données et j'ai besoin d'importer un fichier xml dans CE fichier excel (en créant une nouvelle feuille par exemple).

J'ai réussi à créer une macro réalisant cette tâche (code ci-dessous):

ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:="FINDER;E:\Documents and Settings\u0557730\Bureau\PDCA.xml", Destination:=Range("A1"))
.Name = "PDCA"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

SAUF QUE la macro va chercher le fichier xml à un emplacement bien défini de l'ordinateur, ce qui n'est pas pratique...

J'ai trouvé sur le forum ce code:

encore:
FichierOk = Application.Dialogs(xlDialogOpen).Show
If Not FichierOk Then
MsgBox " Vous devez choisir un fichier"
GoTo encore
End If

Ce code permet d'ouvrir une fenêtre de recherche pour récupérer le fichier xml à l'endroit de mon choix mais nouveau problème: le fichier xml est importé dans un nouveau fichier excel et non pas dans MON fichier excel!

Je cherche désespéremment depuis une semaine à mixer ces deux programmes afin d'importer par macro ce fichier xml dans mon fichier excel en passant par une fenêtre de recherche...

Quelqu'un pourrait-il m'aider?? J'ai cherché dans tout le forum mais ce problème n'est posé nul part...

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 8

Jeremie2011 Messages postés 8 Date d'inscription vendredi 11 janvier 2013 Statut Membre Dernière intervention 25 mars 2014
11 janv. 2013 à 17:01

J'obtiens un message d'erreur:

"Erreur d'execution
Erreur définie par l'application ou par l'objet"

J'ai placé le code comme ceci et l'erreur se situe sur la 4eme ligne:

Range("E31").Select
ActiveWorkbook.Worksheets.Add
PDCA = Application.GetOpenFilename("PDCA (*.xml),*.xml", , "Choisir le fichier")With ActiveSheet.QueryTables.Add(Connection:=PDCA, Destination:=Range("A1"))
.Name = "PDCA"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Réponse 6 / 8

pilas31 Messages postés 1825 Date d'inscription vendredi 5 septembre 2008 Statut Contributeur Dernière intervention 24 avril 2020 643
12 janv. 2013 à 00:33

Oui au temps pour moi j'ai été un peu rapide voila deux corrections :
1/ j'ai ajouté "FINDER"
2/ j'ai traité le cas ou l'utilisateur ne choisit pas de fichier et dans ce cas PDCA prend la valeur False.

Voila le code correct :

Range("E31").Select
ActiveWorkbook.Worksheets.Add
PDCA = Application.GetOpenFilename("PDCA (*.xml),*.xml", , "Choisir le fichier")
If PDCA <> False Then
    With ActiveSheet.QueryTables.Add(Connection:="FINDER;" & PDCA, Destination:=Range("A1"))
    .Name = "PDCA"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlAllTables
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    End With
End If

A+

HardyPetit
3 févr. 2015 à 17:12

Super methode merci.
j'ai fait quelques arrangements pour corresponde à mon besoin
si cela peut aider quelqu'un.

Dim SheetRenew as String
Dim xmlfilefrom As String
Dim FileFrom as String
Dim SheetName as string

Sub PasteXmlData()
FileFrom = "Fichier.xml"
SheetRenew = "Imported_Data"
For Each ws In Worksheets
SheetName = ws.Name
If SheetName = SheetRenew Then
Sheets(SheetRenew).Visible = True
Sheets(SheetRenew).Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End If
Next ws
Sheets.Add.Name = SheetRenew
Sheets(SheetRenew).Select
Range("A1").Select
xmlfilefrom = (ThisWorkbook.Path & "\DataBase\" & FileFrom)
With ActiveSheet.QueryTables.Add(Connection:="FINDER;" & xmlfilefrom, Destination:=ActiveCell)
.Name = "PDCA"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

End Sub

Réponse 7 / 8

Jeremie2011 Messages postés 8 Date d'inscription vendredi 11 janvier 2013 Statut Membre Dernière intervention 25 mars 2014
12 janv. 2013 à 14:43

Pilas,

Tout d'abord un grand MERCI pour ton aide!

J'ai testé et le programme semble fonctionner, cependant, il me manque le fichier XML à importer pour tester correctement ce week-end mais je te fais un retour dès Lundi 8h!

Cordialement,

Jérémie

Réponse 8 / 8

Jeremie2011 Messages postés 8 Date d'inscription vendredi 11 janvier 2013 Statut Membre Dernière intervention 25 mars 2014
14 janv. 2013 à 08:20

Salut,

comme promis j'ai vérifié et le programme fonctionne à merveille!

Merci beaucoup!

Jérémie

Discussions similaires

comment donner les droits sur fichier partage

Discussions similaires

Newsletters