Programadores freelance - webServices: Iva Sii y Xml en MsAccess 2010

Private Sub CmdEnvio_Click()

    Call enviafcturaemitida

End Sub

Private Sub enviafcturaemitida()

    Dim sMsg As String

    Dim sURL As String

    Dim sEnv As String

    Dim XML_Node As IXMLDOMNode

    Dim objHttp  As Object

    Dim XMLDoc As MSXML2.DOMDocument60

    Me.TxtRespuesta = vbNullString

    sURL = "https://www7.aeat.es/wlpl/SSII-FACT/ws/fe/SiiFactFEV1SOAP"

 ''''' Chr(34)=  "

sEnv = vbNullString

sEnv = sEnv & "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"

sEnv = sEnv & "<soapenv:Envelope xmlns:soapenv=" & Chr(34) & "http://schemas.xmlsoap.org/soap/envelope/" & Chr(34) & " xmlns:siiLR=" & Chr(34) _

                   & "https://www2.agenciatributaria.gob.es/static_files/common/internet/dep/aplicaciones/es/aeat/ssii/fact/ws/SuministroLR.xsd" & Chr(34) _

                   & " xmlns:sii=" & Chr(34) & "https://www2.agenciatributaria.gob.es/static_files/common/internet/dep/aplicaciones/es/aeat/ssii/fact/ws/SuministroInformacion.xsd" & Chr(34) & ">"

sEnv = sEnv & "<soapenv:Header/>"

sEnv = sEnv & "<soapenv:Body>"

sEnv = sEnv & "<siiLR:SuministroLRFacturasEmitidas>"

sEnv = sEnv & "<sii:Cabecera>"

    sEnv = sEnv & "<sii:IDVersionSii>" & Me.txtVersionSII & "</sii:IDVersionSii>"

    sEnv = sEnv & "<sii:Titular>"

    sEnv = sEnv & "<sii:NombreRazon>" & Me.TxtAñoEmpresa & "</sii:NombreRazon>"

    sEnv = sEnv & "<sii:NIF>" & Me.TxtNifEmpresa & "</sii:NIF>"

    sEnv = sEnv & "</sii:Titular>"

    sEnv = sEnv & "<sii:TipoComunicacion>" & Me.TxtTipoComunicacion & "</sii:TipoComunicacion>"

sEnv = sEnv & "</sii:Cabecera>"

sEnv = sEnv & "<siiLR:RegistroLRFacturasEmitidas>"

sEnv = sEnv & "<sii:PeriodoImpositivo>"

    sEnv = sEnv & "<sii:Ejercicio>" & Me.TxtAñoEmpresa & "</sii:Ejercicio>"

    sEnv = sEnv & "<sii:Periodo>" & Me.TxtMesEmpresa & "</sii:Periodo>"

sEnv = sEnv & "</sii:PeriodoImpositivo>"

sEnv = sEnv & "<siiLR:IDFactura>"

    sEnv = sEnv & "<sii:IDEmisorFactura>"

    sEnv = sEnv & "<sii:NIF>" & Me.TxtNifEmpresa & "</sii:NIF>"

    sEnv = sEnv & "</sii:IDEmisorFactura>"

    sEnv = sEnv & "<sii:NumSerieFacturaEmisor>" & Me.txtNumeroFactura & "</sii:NumSerieFacturaEmisor>"

    sEnv = sEnv & "<sii:FechaExpedicionFacturaEmisor>" & Me.TxtFechaExpedicion & "</sii:FechaExpedicionFacturaEmisor>"

sEnv = sEnv & "</siiLR:IDFactura>"

sEnv = sEnv & "<siiLR:FacturaExpedida>"

    sEnv = sEnv & "<sii:TipoFactura>" & Me.TxtTipoFActura & "</sii:TipoFactura>"

    sEnv = sEnv & "<sii:FechaOperacion>" & Me.txtFechaOperacion & "</sii:FechaOperacion>"

    sEnv = sEnv & "<sii:ClaveRegimenEspecialOTrascendencia>" & Me.txtClaveRegimenEspecial & "</sii:ClaveRegimenEspecialOTrascendencia>"

    sEnv = sEnv & "<sii:ImporteTotal>" & Me.TxtTotalFactura & "</sii:ImporteTotal>"

    sEnv = sEnv & "<sii:DescripcionOperacion>" & Me.txtDescripcionOperacion & "</sii:DescripcionOperacion>"

sEnv = sEnv & "<sii:Contraparte>"

    sEnv = sEnv & "<sii:NombreRazon>" & Trim(Me.txtNombreEmpresaCompradora) & "</sii:NombreRazon>"

    sEnv = sEnv & "<sii:NIF>" & Trim(Me.txtNifEmpresaCompradora) & "</sii:NIF>"

sEnv = sEnv & "</sii:Contraparte>"

sEnv = sEnv & "<sii:TipoDesglose>"

sEnv = sEnv & "<sii:DesgloseFactura>"

sEnv = sEnv & "<sii:Sujeta>"

sEnv = sEnv & "<sii:NoExenta>"

    sEnv = sEnv & "<sii:TipoNoExenta>S1</sii:TipoNoExenta>"

    sEnv = sEnv & "<sii:DesgloseIVA>"

        sEnv = sEnv & "<sii:DetalleIVA>"

        sEnv = sEnv & "<sii:TipoImpositivo>" & Me.TxtTipoIva & "</sii:TipoImpositivo>"

        sEnv = sEnv & "<sii:BaseImponible>" & Me.TxtBaseImponible & "</sii:BaseImponible>"

        sEnv = sEnv & "<sii:CuotaRepercutida>" & Me.TxtCuotaIva & "</sii:CuotaRepercutida>"

        sEnv = sEnv & "<sii:TipoRecargoEquivalencia>0</sii:TipoRecargoEquivalencia>"

        sEnv = sEnv & "<sii:CuotaRecargoEquivalencia>0</sii:CuotaRecargoEquivalencia>"

        sEnv = sEnv & "</sii:DetalleIVA>"

    sEnv = sEnv & "</sii:DesgloseIVA>"

sEnv = sEnv & "</sii:NoExenta>"

sEnv = sEnv & "</sii:Sujeta>"

sEnv = sEnv & "</sii:DesgloseFactura>"

sEnv = sEnv & "</sii:TipoDesglose>"

sEnv = sEnv & "</siiLR:FacturaExpedida>"

sEnv = sEnv & "</siiLR:RegistroLRFacturasEmitidas>"

sEnv = sEnv & "</siiLR:SuministroLRFacturasEmitidas>"

sEnv = sEnv & "</soapenv:Body>"

sEnv = sEnv & "</soapenv:Envelope>"

    Me.TxtRespuesta = vbNullString

    Me.TxtRespuesta = sEnv

    'Exit Sub

    Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")

    Set XMLDoc = New MSXML2.DOMDocument60

    objHttp.Open "Post", sURL, False

    objHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"

    objHttp.SetOption SXH_OPTION_SELECT_CLIENT_SSL_CERT, "El certificado de mi empresa"

    objHttp.send (sEnv)

    'XMLDoc.async = False

    XMLDoc.Load (objHttp.responseXML)

         Dim HTTPResult As String

         HTTPResult = objHttp.responseText

         Me.TxtRespuesta = HTTPResult

     'Exit Sub

    If XMLDoc.parseError.errorCode = 0 Then

        If XMLDoc.ReadyState = 4 Then

           AddNode XMLDoc.documentElement

        End If

    Else

        MsgBox XMLDoc.parseError.reason & vbCrLf & XMLDoc.parseError.Line & vbCrLf & XMLDoc.parseError.srcText

    End If

    Set XMLDoc = Nothing

    Set objHttp = Nothing

    Set XMLDoc = Nothing

End Sub

Private Sub AddNode(ByRef XML_Node As IXMLDOMNode, Optional ByRef TreeNode As Node)

    Dim xNode As Node

    Dim xNodeList As IXMLDOMNodeList

    Dim i As Long

    If XML_Node.nodeTypedValue = "env:ClientCodigo[-1].No identificado" Then

    If XML_Node.nodeTypedValue = "env:ClientCodigo[-1].No identificado" Then

       Me.txtNombreEmpresaCompradora = "Codigo no identificado"

    End If

    If Left(XML_Node.nodeTypedValue, 9) = Trim(Me.txtNifEmpresaCompradora) Then

    End If

    If Right(XML_Node.nodeTypedValue, Len(XML_Node.nodeTypedValue) - 9) <> Trim(Me.txtNombreEmpresaCompradora) Then

        Me.txtNombreEmpresaCompradora = Right(XML_Node.nodeTypedValue, Len(XML_Node.nodeTypedValue) - 9)

    End If

    End If

    If TreeNode Is Nothing Then

        Set xNode = TreeView1.Nodes.Add

    Else

        Set xNode = TreeView1.Nodes.Add(TreeNode, tvwChild)

    End If

    xNode.Expanded = True

    xNode.Text = XML_Node.nodeName

    If xNode.Text = "#text" Then

        xNode.Text = XML_Node.nodeTypedValue

    Else

        xNode.Text = "<" + xNode.Text + ">"

    End If

    Set xNodeList = XML_Node.childNodes

    For i = 0 To xNodeList.length - 1

        AddNode xNodeList.Item(i), xNode

    Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub CompruebaNif()

    Dim sMsg As String

    Dim sURL As String

    Dim sEnv As String

    Dim XML_Node As IXMLDOMNode

    Dim objHttp  As Object

    Dim XMLDoc As MSXML2.DOMDocument60

    sURL = "https://www1.agenciatributaria.gob.es/wlpl/BURT-JDIT/ws/VNifV1SOAP"

    sEnv = "<?xml version=""1.0"" encoding=""utf-8""?>"

    sEnv = sEnv & "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:vnif=""http://www2.agenciatributaria.gob.es/static_files/common/internet/dep/aplicaciones/es/aeat/burt/jdit/ws/VNifV1Ent.xsd"">"

    sEnv = sEnv & "<soapenv:Header/>"

    sEnv = sEnv & "<soapenv:Body>"

    sEnv = sEnv & "<vnif:VNifV1Ent>"

    sEnv = sEnv & "<vnif:Nif>" & Trim(txtNifEmpresaCompradora) & "</vnif:Nif>"

    sEnv = sEnv & "<vnif:Nombre>" & Trim(txtNombreEmpresaCompradora) & "</vnif:Nombre>"

    sEnv = sEnv & "</vnif:VNifV1Ent>"

    sEnv = sEnv & "</soapenv:Body>"

    sEnv = sEnv & "</soapenv:Envelope>"

    Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")

    Set XMLDoc = New MSXML2.DOMDocument60

    objHttp.Open "Post", sURL, False

    objHttp.setRequestHeader "Content-Type", "text/xml"

    objHttp.SetOption SXH_OPTION_SELECT_CLIENT_SSL_CERT, "El certificado de mi empresa"

    objHttp.send (sEnv)

    XMLDoc.async = False

    XMLDoc.Load (objHttp.responseXML)

    If XMLDoc.parseError.errorCode = 0 Then

        If XMLDoc.ReadyState = 4 Then

           AddNodeNif XMLDoc.documentElement

        End If

    Else

        MsgBox XMLDoc.parseError.reason & vbCrLf & XMLDoc.parseError.Line & vbCrLf & XMLDoc.parseError.srcText

    End If

    Set XMLDoc = Nothing

    Set objHttp = Nothing

    Set XMLDoc = Nothing

End Sub

Private Sub AddNodeNif(ByRef XML_Node As IXMLDOMNode, Optional ByRef TreeNode As Node)

    Dim xNode As Node

    Dim xNodeList As IXMLDOMNodeList

    Dim i As Long

    If XML_Node.nodeTypedValue = "env:ClientCodigo[-1].No identificado" Then

    If XML_Node.nodeTypedValue = "env:ClientCodigo[-1].No identificado" Then

       Me.txtNombreEmpresaCompradora = "Codigo no identificado": Me.txtNombreEmpresaCompradora.SetFocus

       MsgBox "Codigo DE EMPRESA no identificado", vbCritical, "Balances"

    End If

    If Left(XML_Node.nodeTypedValue, 9) = Trim(Me.txtNifEmpresaCompradora) Then

    End If

    If Right(XML_Node.nodeTypedValue, Len(XML_Node.nodeTypedValue) - 9) <> Trim(Me.txtNombreEmpresaCompradora) Then

        Me.txtNombreEmpresaCompradora = Right(XML_Node.nodeTypedValue, Len(XML_Node.nodeTypedValue) - 9)

    End If

    End If

   If TreeNode Is Nothing Then

        Set xNode = TreeView1.Nodes.Add

    Else

        Set xNode = TreeView1.Nodes.Add(TreeNode, tvwChild)

    End If

    xNode.Expanded = True

    xNode.Text = XML_Node.nodeName

    If xNode.Text = "#text" Then

        xNode.Text = XML_Node.nodeTypedValue

    Else

        xNode.Text = "<" + xNode.Text + ">"

    End If

    Set xNodeList = XML_Node.childNodes

    For i = 0 To xNodeList.length - 1

        AddNode xNodeList.Item(i), xNode

    Next

End Sub

Private Sub txtNifEmpresaCompradora_AfterUpdate()

 Call CompruebaNif

End Sub