Ouvrir un fichier XML

[nomade333]

bonjour,
J 'ai le code suivant ci dessous:

Code :

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
Sub importXml_Click()
Dim i As Long
Dim caract As String * 1
Dim filebox As OPENFILENAME
Dim fname As String
Dim result As Long
With filebox
        .lStructSize = Len(filebox)
        .hInstance = 0
        .lpstrFilter = "Fichier *.XML" & vbNullChar & "*.xml" & vbNullChar & _
                       "Fichier *.SGM ou *.TMP" & vbNullChar & "*.sgm" & vbNullChar & _
                       "Tout fichier (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
        .nMaxCustomFilter = 0
        .nFilterIndex = 1
        '.lpstrFile = Space(256) & vbNullChar
        .nMaxFile = Len(.lpstrFile)
        '.lpstrFileTitle = Space(256) & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = "A:*.*" & vbNullChar
        .lpstrTitle = "Selectionner le fichier à visualiser" & vbNullChar
        .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
        .nFileOffset = 0
        .nFileExtension = 0
        .lCustData = 0
        .lpfnHook = 0
End With
result = GetOpenFileName(filebox)
  If result = False Then
     MsgBox "Pas de fichier seléctionné"
     Exit Sub
End If
 
' ????????????????????
Dim oXmldoc, ident, balise, champ As Object
Dim oRs As DAO.Recordset
 
'vider la table
CurrentDb.Execute "delete from IDENTpiece", dbFailOnError
 
Set oXmldoc = CreateObject("Microsoft.XMLDOM")
 
oXmldoc.async = False
oXmldoc.Load (filebox.lpstrFile)
 
Set oRs = CurrentDb.OpenRecordset("IDENTpiece", dbOpenTable)
 
For Each ident In oXmldoc.selectNodes("//IDENT")
    oRs.AddNew
    For Each champ In oRs.Fields
        Set balise = ident.selectSingleNode("./" + champ.Name)
        If Not balise Is Nothing Then
            oRs(champ.Name) = balise.Text
        End If
    Next champ
    oRs.Update
Next ident
 
oRs.Close
Set oXmldoc = Nothing
End Sub

Celui-ci fonctionne correctement sauf que rien n'est téléchargé dans la table IDENTpiece
Quelqu'un serait il me dire pourquoi?
Je ne sais pas quelle infos vous sont nécessaires pour m'aider mais je suis prêt à répondre à vos interrogation.
Merci par avance à tous

ci dessous exemple de données que je veux inscrire dans la table IDENTpiece

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
<?xml version="1.0" encoding="ISO-8859-1" ?>
<!DOCTYPE LIM SYSTEM "lim0075.DTD">
 
<LIM DATE="20110721">
<PIECE>
<INFO>
<IDENT>
	<SER>BB87958C</SER>
	<FAB>F0301</FAB>
	<ART>307-237-118-0</ART>
	<NNO>2840145164112</NNO>
	<DENOFR>AUBE MOBILE,TURB HP</DENOFR>
	<DENOGB>Blade, HP tubine</DENOGB>
	<VERSION>M88-2</VERSION>
	<DATLIV>20030519</DATLIV>
	<DATMS>19000101</DATMS>
	<SEREQ>0</SEREQ>
	<CTRIND></CTRIND>
	<CTRCLI></CTRCLI>
	<MARCHE>0282131</MARCHE>
	<DATMARCH>19991124</DATMARCH>
	<CSN>72520001A025</CSN>
	<ISN>00A</ISN>
	<VERLMI>0075A</VERLMI>

[LedZeppII]

Bonsoir,

Il ne faut pas mettre cette ligne en commentaire

Code :

        '.lpstrFile = Space(256) & vbNullChar

Ensuite j'ai ajouté une récupération du nom de fichier dans la variable strFile,
et j'ai ajouté un affichage d'une éventuelle erreur d'interprétation du xml.

Code :

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
Sub importXml_Click()
Dim i As Long
Dim caract As String * 1
Dim filebox As OPENFILENAME
Dim fname As String
Dim result As Long
With filebox
        .lStructSize = Len(filebox)
        .hInstance = 0
        .lpstrFilter = "Fichier *.XML" & vbNullChar & "*.xml" & vbNullChar & _
                       "Fichier *.SGM ou *.TMP" & vbNullChar & "*.sgm" & vbNullChar & _
                       "Tout fichier (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
        .nMaxCustFilter = 0
        .nFilterIndex = 1
        .lpstrFile = Space(256) & vbNullChar
        .nMaxFile = Len(.lpstrFile)
        '.lpstrFileTitle = Space(256) & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = "A:*.*" & vbNullChar
        .lpstrTitle = "Selectionner le fichier à visualiser" & vbNullChar
        .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
        .nFileOffset = 0
        .nFileExtension = 0
        .lCustData = 0
        .lpfnHook = 0
End With
result = GetOpenFileName(filebox)
  If result = False Then
     MsgBox "Pas de fichier seléctionné"
     Exit Sub
End If
 
' ????????????????????
Dim oXmldoc, ident, balise, champ As Object
Dim oRs As DAO.Recordset
Dim strFile As String
 
'vider la table
CurrentDb.Execute "delete from IDENTpiece", dbFailOnError
 
Set oXmldoc = CreateObject("Microsoft.XMLDOM")
 
oXmldoc.async = False
strFile = Left(filebox.lpstrFile, InStr(1, filebox.lpstrFile, vbNullChar) - 1)
oXmldoc.Load strFile
 
If oXmldoc.parseError.errorCode <> 0 Then
   MsgBox oXmldoc.parseError.reason
   Exit Sub
End If
 
Set oRs = CurrentDb.OpenRecordset("IDENTpiece", dbOpenTable)
 
For Each ident In oXmldoc.selectNodes("//IDENT")
    oRs.AddNew
    For Each champ In oRs.Fields
        Set balise = ident.selectSingleNode("./" + champ.Name)
        If Not balise Is Nothing Then
            oRs(champ.Name) = balise.Text
        End If
    Next champ
    oRs.Update
Next ident
 
oRs.Close
Set oXmldoc = Nothing
End Sub

J'ai une erreur sur le fait que le fichier lim0075.DTD est introuvable.
En enlevant la référence à ce fichier dans le xml (pour tester), le code fonctionne.

A+

[nomade333]

Bonsoir et merci,
Je précise que je travaille sous Access 2000 (au boulot) et 2003 (chez moi).
Lorsque j'exécute le code voici le message d'erreur retourné.
Erreur de compilation
Membre de méthode ou de données introuvable.

pièce jointe

Merci

[LedZeppII]

Bonjour,

J'ai utilisé ma déclaration du type OPENFILENAME dans lequel le membre nMaxCustFilter s'appelle nMaxCustFilter,
alors que dans ta déclaration du type OPENFILE il doit, je suppose, s'appeler nMaxCustomFilter.

Essaie en remplaçant .nMaxCustFilter par .nMaxCustomFilter

A+

[nomade333]

Bonsoir et merci,
L'erreur c'est déplacée voici:
merci par avance

[LedZeppII]

Bonsoir,

C'est bizarre car Space fait partie de la bibliothèque VBA depuis au moins Access 97.
Vérifie si tu n'as pas un problème de référence Visual Basic.
Dans l'éditeur Visual Basic, va dans Outils > Références et regarde s'il n'y a pas des références marquée "Manquante".
Voir faq

A+

[nomade333]

Bonsoir et merci,
voici mes références vba!
Merci encore.

[LedZeppII]

Bonjour,

l'avant dernière référence (Microsoft Windows Common Controls-2...) est préfixée "MANQUANT:" pour signifier qu'elle pose problème.

Il faut la décocher pour que VB puisse compiler sans erreur.

A+

[nomade333]

Bonsoir,
Désolé d'avoir tardé.
Ok je n'ai plus d'erreur, merci.
Mais cela ne fonctionne toujours pas, j'ouvre bien la fenêtre de sélection du fichier XML, je sélectionne mon fichier, mais lorsque je vais voir dans Access il n'y a aucune données dans ma table IDENTpiece ?????
Est ce que que cette fonction XML et géré par Access 2000 ou Access 2003, ou me faut il la version Access 2007?
Merci par avance.

[LedZeppII]

Bonsoir,

La partie XML Set oXmldoc = CreateObject("Microsoft.XMLDOM") ne fait pas partie d'Access.
Ça ne dépend donc pas de la version d'Access.

Est-ce que tu pourrai poster ton fichier xml que je fasse un essai ?

A+

[nomade333]

Bonjour et merci.
ci joint 2 exemples de fichiers xml ainsi que ma base en construction.
merci encore

[LedZeppII]

Bonjour,

Il y a deux lignes incorrectes dans ton code.

Code :

For Each ident In oXmldoc.selectNodes("IDENT")

et

Code :

Set balise = ident.selectSingleNode(".\" + champ.Name)

devraient être, respectivement :

Code :

For Each ident In oXmldoc.selectNodes("//IDENT")

et

Code :

Set balise = ident.selectSingleNode("./" + champ.Name)

Après le chargement du fichier xml, c'est à dire après cette ligne ...

Code :

oXmldoc.Load (filebox.lpstrFile)

... je te suggère de laisser le bout de code que j'avais mis la première fois :

Code :

1
2
3
4
If oXmldoc.parseError.errorCode <> 0 Then
   MsgBox oXmldoc.parseError.reason
   Exit Sub
End If

Cela permet d'afficher d'éventuelles erreurs.
Notamment celle que j'ai :

Le système ne trouve pas l'objet spécifié.
Erreur de traitement de la ressource lim0075.DTD.

Comme je l'avais dit la première fois, la deuxième ligne du fichier xml ...

Code xml :

<!DOCTYPE LIM SYSTEM "lim0075.DTD">

... me génère une erreur car je ne dispose pas de ce fichier (lim0075.DTD).
Pour l'instant je la mettais en commentaire.
Si comme moi tu as l'erreur, je viens de trouver une autre méthode, sans mettre le DTD en commentaire.
Remplacer :

Code :

1
2
oXmldoc.async = False
oXmldoc.Load (filebox.lpstrFile)

par

Code :

1
2
3
4
oXmldoc.async = False
oXmldoc.resolveExternals = False
oXmldoc.validateOnParse = False
oXmldoc.Load (filebox.lpstrFile)

A+