Tengo la siguiente macro pero no logro hacer que me deje de poner el nombre del la ruta del archivo, alguien que me pueda ayudar
Sub Ruta_CFDI()
Dim fs, carpeta, archivo, subcarpeta As Object
contador = 2
Set fs = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
Ruta = .SelectedItems(1)
End If
End With
If Ruta = "" Then
Exit Sub
End If
Set carpeta = fs.GetFolder(Ruta)
For Each archivo In carpeta.Files
If Right(archivo, 4) = ".xml" Then
Range("AB" & contador).value = Ruta & "\" & archivo.Name
contador = contador + 1
End If
Next
If contador = 1 Then
MsgBox "No se encontro ningún archivo *.XML" & Chr(10) & Ruta, vbCritical, "Importar datos CFDI"
End If
Call Lectura_CFDI
End Sub
Sub Lectura_CFDI()
Dim doc As MSXML2.DOMDocument60
Dim objXMLDOMNodeList As MSXML2.IXMLDOMNodeList
Dim intIndiceNodo As Integer
Dim Concepto As String
Set doc = New MSXML2.DOMDocument60
Set r = Range("p1").CurrentRegion
filas = r.Rows.Count
For i = 5 To filas
doc.Load ("" & Cells(i, 28) & "")
Cells(i, 8) = 0
Cells(i, 9) = 0
Cells(i, 10) = 0
Set lists = doc.DocumentElement
EmisorRFC = lists.ChildNodes(Emisor).getAttribute("Rfc") & lists.ChildNodes(Emisor).getAttribute("rfc")
EmisorNobmre = lists.ChildNodes(Emisor).getAttribute("nombre") & lists.ChildNodes(Emisor).getAttribute("Nombre")
EmisorRegimen = lists.ChildNodes(Emisor).getAttribute("RegimenFiscal")
ReceptorRFC = lists.ChildNodes(1).getAttribute("rfc") & lists.ChildNodes(1).getAttribute("Rfc")
ReceptorNobmre = lists.ChildNodes(1).getAttribute("nombre") & lists.ChildNodes(1).getAttribute("Nombre")
ReceptorUso = lists.ChildNodes(1).getAttribute("UsoCFDI")
IVA = lists.ChildNodes(3).getAttribute("totalImpuestosTrasladados") & lists.ChildNodes(3).getAttribute("TotalImpuestosTrasladados")
Set objXMLDOMNodeList = lists.ChildNodes
For intIndiceAtributo = 0 To objXMLDOMNodeList.Item(2).ChildNodes.Length - 1
Concepto = Concepto & lists.ChildNodes(2).ChildNodes(intIndiceAtributo).getAttribute("descripcion") & "\" & lists.ChildNodes(2).ChildNodes(intIndiceAtributo).getAttribute("Descripcion") & "\"
Next intIndiceAtributo
For intIndiceAtributo = 0 To objXMLDOMNodeList.Item(3).ChildNodes.Length - 1
If lists.ChildNodes(3).ChildNodes(intIndiceAtributo).nodeName = "cfdi:Retenciones" Then
If lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(intIndiceAtributo).getAttribute("Impuesto") = "IVA" Then
RetIVA = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(0).getAttribute("Importe")
On Error Resume Next
RetISR = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(1).getAttribute("Importe")
Cells(i, 9) = RetISR
Cells(i, 10) = RetIVA
RetISR = 0
RetIVA = 0
Else
On Error Resume Next
RetIVA = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(1).getAttribute("Importe")
RetISR = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(0).getAttribute("Importe")
Cells(i, 12) = RetISR
Cells(i, 13) = RetIVA
RetISR = 0
RetIVA = 0
End If
End If
Next intIndiceAtributo
For intIndiceAtributo = 0 To objXMLDOMNodeList.Item(4).ChildNodes.Length - 1
If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TUA")) Then
TUA = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TUA")
End If
If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("UUID")) Then
Folio = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("UUID")
End If
If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TotaldeTraslados")) Then
ISH = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TotaldeTraslados")
End If
If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("FechaTimbrado")) Then
FechaTimbrado = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("FechaTimbrado") & lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("FechaTimbrado")
End If
If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("RfcProvCertif")) Then
RfcProvCertif = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("RfcProvCertif")
End If
Next intIndiceAtributo
Cells(i, 2) = doc.DocumentElement.getAttribute("serie") & doc.DocumentElement.getAttribute("Serie")
Cells(i, 3) = doc.DocumentElement.getAttribute("Folio") & doc.DocumentElement.getAttribute("folio")
Cells(i, 4) = ReceptorRFC
Cells(i, 5) = ReceptorNobmre
Cells(i, 6) = EmisorRFC
Cells(i, 7) = EmisorNobmre
Cells(i, 8) = Folio
Cells(i, 9) = Concepto
Cells(i, 10) = doc.DocumentElement.getAttribute("subTotal") & doc.DocumentElement.getAttribute("SubTotal")
Cells(i, 11) = IVA
Cells(i, 14) = doc.DocumentElement.getAttribute("total") & doc.DocumentElement.getAttribute("Total")
Cells(i, 15) = doc.DocumentElement.getAttribute("fecha") & doc.DocumentElement.getAttribute("Fecha")
Cells(i, 16) = doc.DocumentElement.getAttribute("fecha") & doc.DocumentElement.getAttribute("FechaTimbrado")
Cells(i, 17) = doc.DocumentElement.getAttribute("tipoDeComprobante") & doc.DocumentElement.getAttribute("TipoDeComprobante")
Cells(i, 18) = doc.DocumentElement.getAttribute("CondicionesDePago") & doc.DocumentElement.getAttribute("CondicionesDePago")
Cells(i, 19) = doc.DocumentElement.getAttribute("FormaPago")
Cells(i, 20) = doc.DocumentElement.getAttribute("metodoDePago") & doc.DocumentElement.getAttribute("MetodoPago")
Cells(i, 21) = EmisorRegimen
Cells(i, 22) = ReceptorUso
Cells(i, 23) = doc.DocumentElement.getAttribute("Moneda")
Cells(i, 24) = doc.DocumentElement.getAttribute("LugarExpedicion")
Cells(i, 25) = doc.DocumentElement.getAttribute("NoCertificado") & doc.DocumentElement.getAttribute("noCertificado")
Cells(i, 26) = doc.DocumentElement.getAttribute("version") & doc.DocumentElement.getAttribute("Version")
Cells(i, 27) = RfcProvCertif
ReceptorRFC = ""
ReceptorNobmre = ""
EmisorRFC = ""
EmisorNobmre = ""
Folio = ""
Concepto = ""
If Cells(i, 11) = "" Then
Cells(i, 11) = 0
End If
If Cells(i, 12) = "" Then
Cells(i, 12) = 0
End If
Next
Set doc = Nothing
MsgBox "Mario A. Rodríguez" & Chr(10) & "importado"
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Tengo la siguiente macro pero no logro hacer que me deje de poner el nombre del la ruta del archivo, alguien que me pueda ayudar
Sub Ruta_CFDI() Dim fs, carpeta, archivo, subcarpeta As Object contador = 2 Set fs = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then Ruta = .SelectedItems(1) End If End With If Ruta = "" Then Exit Sub End If Set carpeta = fs.GetFolder(Ruta) For Each archivo In carpeta.Files If Right(archivo, 4) = ".xml" Then Range("AB" & contador).value = Ruta & "\" & archivo.Name contador = contador + 1 End If Next If contador = 1 Then MsgBox "No se encontro ningún archivo *.XML" & Chr(10) & Ruta, vbCritical, "Importar datos CFDI" End If Call Lectura_CFDI End Sub Sub Lectura_CFDI() Dim doc As MSXML2.DOMDocument60 Dim objXMLDOMNodeList As MSXML2.IXMLDOMNodeList Dim intIndiceNodo As Integer Dim Concepto As String Set doc = New MSXML2.DOMDocument60 Set r = Range("p1").CurrentRegion filas = r.Rows.Count For i = 5 To filas doc.Load ("" & Cells(i, 28) & "") Cells(i, 8) = 0 Cells(i, 9) = 0 Cells(i, 10) = 0 Set lists = doc.DocumentElement EmisorRFC = lists.ChildNodes(Emisor).getAttribute("Rfc") & lists.ChildNodes(Emisor).getAttribute("rfc") EmisorNobmre = lists.ChildNodes(Emisor).getAttribute("nombre") & lists.ChildNodes(Emisor).getAttribute("Nombre") EmisorRegimen = lists.ChildNodes(Emisor).getAttribute("RegimenFiscal") ReceptorRFC = lists.ChildNodes(1).getAttribute("rfc") & lists.ChildNodes(1).getAttribute("Rfc") ReceptorNobmre = lists.ChildNodes(1).getAttribute("nombre") & lists.ChildNodes(1).getAttribute("Nombre") ReceptorUso = lists.ChildNodes(1).getAttribute("UsoCFDI") IVA = lists.ChildNodes(3).getAttribute("totalImpuestosTrasladados") & lists.ChildNodes(3).getAttribute("TotalImpuestosTrasladados") Set objXMLDOMNodeList = lists.ChildNodes For intIndiceAtributo = 0 To objXMLDOMNodeList.Item(2).ChildNodes.Length - 1 Concepto = Concepto & lists.ChildNodes(2).ChildNodes(intIndiceAtributo).getAttribute("descripcion") & "\" & lists.ChildNodes(2).ChildNodes(intIndiceAtributo).getAttribute("Descripcion") & "\" Next intIndiceAtributo For intIndiceAtributo = 0 To objXMLDOMNodeList.Item(3).ChildNodes.Length - 1 If lists.ChildNodes(3).ChildNodes(intIndiceAtributo).nodeName = "cfdi:Retenciones" Then If lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(intIndiceAtributo).getAttribute("Impuesto") = "IVA" Then RetIVA = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(0).getAttribute("Importe") On Error Resume Next RetISR = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(1).getAttribute("Importe") Cells(i, 9) = RetISR Cells(i, 10) = RetIVA RetISR = 0 RetIVA = 0 Else On Error Resume Next RetIVA = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(1).getAttribute("Importe") RetISR = lists.ChildNodes(3).ChildNodes(intIndiceAtributo).ChildNodes(0).getAttribute("Importe") Cells(i, 12) = RetISR Cells(i, 13) = RetIVA RetISR = 0 RetIVA = 0 End If End If Next intIndiceAtributo For intIndiceAtributo = 0 To objXMLDOMNodeList.Item(4).ChildNodes.Length - 1 If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TUA")) Then TUA = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TUA") End If If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("UUID")) Then Folio = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("UUID") End If If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TotaldeTraslados")) Then ISH = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("TotaldeTraslados") End If If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("FechaTimbrado")) Then FechaTimbrado = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("FechaTimbrado") & lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("FechaTimbrado") End If If Not IsNull(lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("RfcProvCertif")) Then RfcProvCertif = lists.ChildNodes(4).ChildNodes(intIndiceAtributo).getAttribute("RfcProvCertif") End If Next intIndiceAtributo Cells(i, 2) = doc.DocumentElement.getAttribute("serie") & doc.DocumentElement.getAttribute("Serie") Cells(i, 3) = doc.DocumentElement.getAttribute("Folio") & doc.DocumentElement.getAttribute("folio") Cells(i, 4) = ReceptorRFC Cells(i, 5) = ReceptorNobmre Cells(i, 6) = EmisorRFC Cells(i, 7) = EmisorNobmre Cells(i, 8) = Folio Cells(i, 9) = Concepto Cells(i, 10) = doc.DocumentElement.getAttribute("subTotal") & doc.DocumentElement.getAttribute("SubTotal") Cells(i, 11) = IVA Cells(i, 14) = doc.DocumentElement.getAttribute("total") & doc.DocumentElement.getAttribute("Total") Cells(i, 15) = doc.DocumentElement.getAttribute("fecha") & doc.DocumentElement.getAttribute("Fecha") Cells(i, 16) = doc.DocumentElement.getAttribute("fecha") & doc.DocumentElement.getAttribute("FechaTimbrado") Cells(i, 17) = doc.DocumentElement.getAttribute("tipoDeComprobante") & doc.DocumentElement.getAttribute("TipoDeComprobante") Cells(i, 18) = doc.DocumentElement.getAttribute("CondicionesDePago") & doc.DocumentElement.getAttribute("CondicionesDePago") Cells(i, 19) = doc.DocumentElement.getAttribute("FormaPago") Cells(i, 20) = doc.DocumentElement.getAttribute("metodoDePago") & doc.DocumentElement.getAttribute("MetodoPago") Cells(i, 21) = EmisorRegimen Cells(i, 22) = ReceptorUso Cells(i, 23) = doc.DocumentElement.getAttribute("Moneda") Cells(i, 24) = doc.DocumentElement.getAttribute("LugarExpedicion") Cells(i, 25) = doc.DocumentElement.getAttribute("NoCertificado") & doc.DocumentElement.getAttribute("noCertificado") Cells(i, 26) = doc.DocumentElement.getAttribute("version") & doc.DocumentElement.getAttribute("Version") Cells(i, 27) = RfcProvCertif ReceptorRFC = "" ReceptorNobmre = "" EmisorRFC = "" EmisorNobmre = "" Folio = "" Concepto = "" If Cells(i, 11) = "" Then Cells(i, 11) = 0 End If If Cells(i, 12) = "" Then Cells(i, 12) = 0 End If Next Set doc = Nothing MsgBox "Mario A. Rodríguez" & Chr(10) & "importado"