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