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 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201
| Option Compare Database
'les flag me permettant de savoir où on se situe dans le traitement.
Private IsFichier As Boolean
Private IsImage As Boolean
Private IsEan As Boolean
Private IsCarac As Boolean
Private IsValueCarac As Boolean
Private IntCarac As Integer
Private LineIndex As Integer
Private IsChapitre As Boolean
'Les variables à extraire dans une table
Private ChampEan As String
Private ChampIntituleCarac As String
Private ValeurCarac As String
Private ChampCompletCarac As String
Private NomImage As String
Private NomFichier As String
Implements IVBSAXContentHandler
Implements IVBSAXErrorHandler
Private Sub IVBSAXContentHandler_characters( _
strChars As String)
If IsEan Then
ChampEan = strChars
ElseIf IsValueCarac Then
'ValeurCarac = ValeurCarac & "|" & strChars
ChampCompletCarac = ChampCompletCarac & " : " & strChars & "</p>"
ElseIf IsImage Then
NomImage = strChars
ElseIf IsFichier Then
'Debug.Print "#####################"
'Debug.Print strChars
'NomFichier = NomFichier & "|" & strChars
If strChars Like "*[.]pdf" Then
NomFichier = NomFichier & "|" & strChars
ElseIf strChars Like "*[.]jpg" Then
NomImage = NomImage & "|" & strChars
Else
End If
End If
End Sub
Private Property Set _
IVBSAXContentHandler_documentLocator( _
ByVal RHS As MSXML2.IVBSAXLocator)
End Property
Private Sub IVBSAXContentHandler_endDocument()
'Debug.Print "End of the xml"
End Sub
Private Sub IVBSAXContentHandler_endPrefixMapping( _
strPrefix As String)
End Sub
Private Sub IVBSAXContentHandler_ignorableWhitespace( _
strChars As String)
End Sub
Private Sub IVBSAXContentHandler_processingInstruction( _
strTarget As String, strData As String)
End Sub
Private Sub IVBSAXContentHandler_skippedEntity( _
strName As String)
End Sub
Private Sub IVBSAXContentHandler_startDocument()
'Debug.Print "*******************"
'Debug.Print "Start of XML document"
'IsStartElement = False
'IsValueElement = False
IsEan = False
ChampEan = ""
IsCarac = False
IntCarac = -1
LineIndex = 0
NomFichier = ""
NomImage = ""
End Sub
Private Sub IVBSAXContentHandler_startElement( _
strNamespaceURI As String, _
strLocalName As String, strQName As String, _
ByVal oAttributes As MSXML2.IVBSAXAttributes)
If strLocalName = "ean" Then
ChampEan = ""
IsEan = True
'Extraction du code Ean.
'Debug.Print "StartElement:" & " " & strLocalName & "|" & strNamespaceURI
ElseIf strLocalName Like "c#" Or strLocalName Like "c##" Or strLocalName Like "c###" Then
IsCarac = True
IntCarac = IntCarac + 1
'Recupération des intitulés des caractéristiques en français
'ChampIntituleCarac = ChampIntituleCarac & "|" & oAttributes.getValueFromName("", "fr")
ChampCompletCarac = ChampCompletCarac & "<p class=" & Chr(34) & "desclongb" & Chr(34) & ">" & oAttributes.getValueFromName("", "fr")
ElseIf strLocalName Like "fr" And IsCarac = True Then
IsValueCarac = True
ElseIf strLocalName = "image" Then
IsImage = True
ElseIf strLocalName = "fichier" Then
IsFichier = True
End If
End Sub
Private Sub IVBSAXContentHandler_endElement( _
strNamespaceURI As String, _
strLocalName As String, strQName As String)
If strLocalName = "ean" Then
IsEan = False
'Debug.Print "EndElement:" & " " & strLocalName & "|" & strNamespaceURI
ElseIf strLocalName Like "c#" Or strLocalName Like "c##" Or strLocalName Like "c###" Then
IsCarac = False
ElseIf strLocalName = "chapitre" Then
'Debug.Print strLocalName
IsChapitre = False
'Debug.Print IntCarac
IntCarac = -1
ElseIf strLocalName Like "fr" And IsCarac = True Then
IsValueCarac = False
ElseIf strLocalName = "image" Then
IsImage = False
ElseIf strLocalName = "fichier" Then
IsFichier = False
ElseIf strLocalName = "fichiers" Then
ElseIf strLocalName = "produit" Then
'RAZ des informations et écritures dans la table Access.
Dim rst As dao.Recordset
Dim lngNum As Long
'Ouvrir la table en lecture/écriture
Set rst = CurrentDb.OpenRecordset("tblDestination", dbOpenDynaset)
If TestLogique(ChampEan, "tblDestination", "CodeEan") = False Then
' Créer un enregistrement dans la table
rst.AddNew
' Alimenter les champs
rst("CodeEan") = ChampEan
rst("Caracteristiques") = ChampCompletCarac
rst("NomFichier") = NomFichier
rst("NomImage") = NomImage
' Valider
rst.Update
rst.Close
Set rst = Nothing
Else
End If
'Debug.Print ChampEan
'Debug.Print ChampIntituleCarac
'Debug.Print ValeurCarac
'Debug.Print ChampCompletCarac
'Debug.Print NomFichier
'Debug.Print NomImage
NomFichier = ""
NomImage = ""
ChampCompletCarac = ""
CodeEan = ""
End If
End Sub
Private Sub IVBSAXContentHandler_startPrefixMapping( _
strPrefix As String, strURI As String)
End Sub
'GESTION DES ERREURS
Private Sub IVBSAXErrorHandler_error(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub
Private Sub IVBSAXErrorHandler_fatalError(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub
Private Sub IVBSAXErrorHandler_ignorableWarning(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub |
Partager