Dim XMLInner Dim XMLDoc Dim XML_Node Dim XML_NodeDet Dim XML_NodeStatus DIM XML_CFDIResultado Dim XML_NodeDatos Dim XML_NodeMsg Dim XML_CFDI Dim XML_CFDIDat Dim lPos Dim oFileSystemObject Dim oFile Dim lRespuesta Dim sError Dim sErrorExtra dim lSec Dim iProduccion Dim sUser Dim sPsw Dim timbrado Dim sRespuesta Dim sXMLIn Dim sXMLOut Dim sXMLRespuesta xApp.MsgBar "Procesando con PAC SolucionFactible" '***************************************************************** '* DATOS DEL CLIENTE '***************************************************************** '* 0 Pruebas 1 Produccion iProduccion = 0 '***************************************************************** sUser = "testing@solucionfactible.com" sPsw = "timbrado.SF.16672" '***************************************************************** sXMLIn = "" & xTimbre.XMLIn sXMLOut = "" & xTimbre.XMLOut sXMLRespuesta = "" & xTimbre.XMLRespuesta If Len("" & sXMLIn) = 0 Or Len("" & sXMLOut) = 0 Then Exit Sub End If Set timbrado = CreateObject("SF.timbrar") sRespuesta = timbrado.timbrarCFDI(sUser, sPsw, sXMLIn, iProduccion) '* Obtener los datos de respuesta Set XMLDoc = CreateObject("Msxml2.DOMDocument.3.0") XMLDoc.async = False XMLDoc.loadXML sRespuesta 'XMLDoc.load sXMLRespuesta '* Se leyo bien If XMLDoc.parseError.errorCode = 0 Then '* Buscar el nodo inicial Set XML_Node = XMLDoc.documentElement '* Salvar la respuesta XMLDoc.save sXMLRespuesta '* Buscar si hubo error For lPos = 0 To XML_Node.childNodes.Length - 1 Set XML_NodeDet = XML_Node.childNodes.Item(lPos) If XML_NodeDet.nodeName = "error" Then Set XML_NodeDet = XML_NodeDet Exit For Else Set XML_NodeDet = Nothing End If Next '* No hay error If XML_NodeDet Is Nothing Then '* Buscar si hay certificacion For lPos = 0 To XML_Node.childNodes.Length - 1 Set XML_NodeDet = XML_Node.childNodes.Item(lPos) If XML_NodeDet.nodeName = "CFDIResultadoCertificacion" Then Exit For Else Set XML_NodeDet = Nothing End If Next '* Si hay certificacion If Not XML_NodeDet Is Nothing Then For lPos = 0 To XML_NodeDet.childNodes.Length - 1 Set XML_NodeStatus = XML_NodeDet.childNodes.Item(lPos) If XML_NodeStatus.nodeName = "status" Then Exit For Else Set XML_NodeStatus = Nothing End If Next '* Si hay status If Not XML_NodeStatus Is Nothing Then If XML_NodeStatus.Text = "200" or XML_NodeStatus.Text = "307" Then if XML_NodeStatus.Text = "307" then xApp.MsgBar "EL CFDI ya ha sido timbrado previamente, recuperando sus datos" end if Set XML_CFDIResultado = XML_NodeDet If XML_CFDIResultado.nodeName = "CFDIResultadoCertificacion" Then '* Buscar el nodo de UUID For lSec = 0 To XML_CFDIResultado.childNodes.Length - 1 Set XML_NodeDatos = XML_CFDIResultado.childNodes.Item(lSec) If XML_NodeDatos.nodeName = "UUID" Then xTimbre.UUID = XML_NodeDatos.Text Exit For End If Next '* Buscar el nodo de Sello Sat For lSec = 0 To XML_CFDIResultado.childNodes.Length - 1 Set XML_NodeDatos = XML_CFDIResultado.childNodes.Item(lSec) If XML_NodeDatos.nodeName = "SelloSAT" Then xTimbre.SelloSAT = XML_NodeDatos.Text Exit For End If Next '* Buscar el nodo de versionTFD For lSec = 0 To XML_CFDIResultado.childNodes.Length - 1 Set XML_NodeDatos = XML_CFDIResultado.childNodes.Item(lSec) If XML_NodeDatos.nodeName = "VersionTFD" Then xTimbre.Version = XML_NodeDatos.Text Exit For End If Next '* Buscar el nodo de fechaTimbrado For lSec = 0 To XML_CFDIResultado.childNodes.Length - 1 Set XML_NodeDatos = XML_CFDIResultado.childNodes.Item(lSec) If XML_NodeDatos.nodeName = "FechaTimbrado" Then xTimbre.FechaTimbrado = XML_NodeDatos.Text Exit For End If Next '* Buscar el nodo de CertificadoSAT For lSec = 0 To XML_CFDIResultado.childNodes.Length - 1 Set XML_NodeDatos = XML_CFDIResultado.childNodes.Item(lSec) If XML_NodeDatos.nodeName = "CertificadoSAT" Then xTimbre.NoCertificadoSAT = XML_NodeDatos.Text Exit For End If Next '* Buscar el nodo de Cadena Original For lSec = 0 To XML_CFDIResultado.childNodes.Length - 1 Set XML_NodeDatos = XML_CFDIResultado.childNodes.Item(lSec) If XML_NodeDatos.nodeName = "CadenaOriginal" Then xTimbre.CadenaOriginalSAT = XML_NodeDatos.Text Exit For End If Next End if '* Buscar el nodo de CFDI For lPos = 0 To XML_NodeDet.childNodes.Length - 1 Set XML_CFDI = XML_NodeDet.childNodes.Item(lPos) If XML_CFDI.nodeName = "CFDI" Then Exit For Else Set XML_CFDI = Nothing End If Next If Not XML_CFDI Is Nothing Then Set XMLInner = CreateObject("Msxml2.DOMDocument.3.0") XMLInner.async = False XMLInner.loadXML XML_CFDI.Text If XMLInner.parseError.errorCode = 0 Then XMLInner.save sXMLOut lRespuesta = 0 sError = "" sErrorExtra = "" Else lRespuesta = -6 sError = "El CFDI No pudo ser leido" sErrorExtra = XML_CFDI.Text End If Else lRespuesta = -5 sError = "No se obtuvo el CFDI" sErrorExtra = "" End If Else lRespuesta = 1 sError = "Error" sErrorExtra = "" if not XML_Node is nothing then For lPos = 0 To XML_Node.childNodes.Length - 1 Set XML_NodeMsg = XML_Node.childNodes.Item(lPos) If XML_NodeMsg.nodeName = "mensaje" Then Exit For Else Set XML_NodeMsg = Nothing End If Next sError = "" & XML_Node.Text sErrorExtra = XML_NodeMsg.Text end if End If Else lRespuesta = -4 sError = "No se puede leer la respuesta " sErrorExtra = sRespuesta End If Else lRespuesta = -3 sError = "No se puede leer la respuesta " sErrorExtra = sRespuesta End If Else lRespuesta = -2 sError = XML_NodeDet.Text sErrorExtra = "" End If Else lRespuesta = -1 sError = "No se puede leer la respuesta " sErrorExtra = sRespuesta End If '* Liberar objetos Set XML_Node = Nothing Set XML_NodeDet = Nothing Set XML_NodeStatus = Nothing Set XML_NodeMsg = Nothing Set XMLDoc = Nothing Set XMLInner = Nothing '* MsgBox "<" & lRespuesta & ">[" & sError & "][" & sErrorExtra & "]" xTimbre.Respuesta = lRespuesta xTimbre.Error = sError xTimbre.ErrorExtra = sErrorExtra xApp.MsgBar "OK"