IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Import fichiers XML


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Inscrit en
    Octobre 2008
    Messages
    167
    Détails du profil
    Informations forums :
    Inscription : Octobre 2008
    Messages : 167
    Par défaut Import fichiers XML
    Bonjour,

    Tout est dans le titre.
    Je voudrais importer une centaine de fichier XML (tous la meme structure)
    et les enrgister dans un dossier au format TXT en donnant les noms suivants :
    B1, B2, B3....B100 pour les fichiers TXT.

    En vous remerciant par avance.

    J'ai essayé avec cette Macro :

    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
     
    Sub ImporterFichierXML()
        Dim XM As XmlMap
     
        'Importe le fichier dans la cellule B1 de la Feuil3.
     
        ThisWorkbook.XmlImport _
        URL:="C:\Documents and Settings\Desktop\TTT_20130624_001.xml",_
            ImportMap:=Nothing, _
            Overwrite:=True, _
            Destination:=Worksheets("A1").Range("$B$1")
     
            '.Range("$B$1")
     
        'Définit le mappage qui vient d'être ajouté.
        'ThisWorkbook.XmlMaps.Count correspond au dernier xml mappé dans le classeur
        Set XM = ThisWorkbook.XmlMaps(ThisWorkbook.XmlMaps.Count)
     
     
        MsgBox "Import terminé" & vbCrLf & _
            XM.RootElementName & vbCrLf & _
            XM.Name & vbCrLf & _
            XM.DataBinding.SourceUrl
     
    End Sub
    Mais ce code c'est que pour un seul fichier XML

    Merci

  2. #2
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour,

    Une piste à explorer car je n'ai pas testé sur des .xml
    La proc appelle une fonction pour récupérer les noms des fichiers portants l'extension voulue dans le dossier passé en argument ensuite, elle boucle sur le tableau de String retournés, c'est là qu'il te faut adapter à ce que tu veux faire :
    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
     
    Sub RecupFichiers()
     
        Dim Tbl() As String
        Dim Test As Integer
        Dim I As Integer
     
        'récupère les noms des fichiers se terminant par .xml en minuscules
        'les extensions en majuscules sont ignorées
        Tbl() = Fichiers("C:\Documents and Settings\Desktop\", ".xml")
     
        'une erreur est générée si le tableau n'est pas initialisé
        On Error Resume Next
        Test = UBound(Tbl)
     
        If Err.Number <> 0 Then
     
            MsgBox "Aucun fichier dans le dossier !"
            Err.Clear
            Exit Sub
     
        End If
     
        'boucle sur le tableau
        For I = 1 To UBound(Tbl)
     
            '!!! Ici le traitement voulu...
     
            'adapter :
            'si le classeur doit être ouvert
            'Workbooks.Open "C:\Documents and Settings\Desktop\" & Tbl
     
            'enregistrer en .txt
            'ActiveWorkbook.SaveAs "C:\Documents and Settings\Desktop\" & "B" & I & ".txt", xlUnicodeText
     
            'etc...
     
    '        ThisWorkbook.XmlImport Tbl(I), Nothing, True, Worksheets("A1").Range("B1")
    '        Set XM = ThisWorkbook.XmlMaps(ThisWorkbook.XmlMaps.Count)
    '        MsgBox "Import terminé" & vbCrLf & _
    '            XM.RootElementName & vbCrLf & _
    '            XM.Name & vbCrLf & _
    '            XM.DataBinding.SourceUrl
     
     
        Next I
     
    End Sub
     
    'Cette fonction retourne les noms des fichiers présents dans le dossier
    'et ayant l'extension voulue dans un tableau String
    Function Fichiers(Chemin As String, _
                      Extension As String) As String()
     
        Dim Tbl() As String
        Dim Fich As String
        Dim I As Integer
     
        Fich = Dir(Chemin)
     
        Do While (Len(Fich) > 0)
     
            'seuls les fichiers avec l'extension voulue
            If InStr(Fich, Extension) <> 0 Then
     
                I = I + 1
                ReDim Preserve Tbl(1 To I)
                Tbl(I) = Fich
     
            End If
     
            Fich = Dir()
     
        Loop
     
        Fichiers = Tbl()
     
    End Function
    Hervé.

  3. #3
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Bonjour Theze, id301077

    Si je me permet de proposer une petite amélioration dans la fonction proposée
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    Private Function Fichiers(Chemin As String, Extension As String) As String()
    Dim Tbl() As String, Fich As String
    Dim i As Integer
     
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
    Fich = Dir(Chemin & "*." & Extension)
    Do While Len(Fich) > 0
        i = i + 1
        ReDim Preserve Tbl(1 To i)
        Tbl(i) = Chemin & Fich
        Fich = Dir()
    Loop
    Fichiers = Tbl()
    End Function

  4. #4
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour mercatog,

    Toute amélioration est toujours bienvenue ;o)

    Hervé.

Discussions similaires

  1. important fichier XML+ code Java
    Par nonna dans le forum Format d'échange (XML, JSON...)
    Réponses: 5
    Dernier message: 09/02/2008, 13h09
  2. Réponses: 3
    Dernier message: 20/04/2007, 09h46
  3. VBScript : création base Access pour import fichier XML
    Par abertaud dans le forum VBA Access
    Réponses: 3
    Dernier message: 02/04/2007, 14h35
  4. VBScript : création base Access pour import fichier XML
    Par abertaud dans le forum VBScript
    Réponses: 1
    Dernier message: 02/04/2007, 14h34
  5. Importation fichier xml
    Par kastor_lapon dans le forum WinDev
    Réponses: 1
    Dernier message: 01/07/2005, 11h54

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo