Sabes usar macros para importar xlm

Necesito una macro que importe archivo xml desde ventana de archivo

1 Respuesta

Respuesta

La macro es así :

Sub ExtraerFolioFiscal2()
'Act.Por.Dante Amor
    Dim cp, Archivos
    Dim y, Fila, FolioFiscal
    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
    Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
    '
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo de excel"
        .Filters.Clear
        .Filters.Add "Archivos Xml", "*.xml*"
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path & "\"
        If Not .Show Then Exit Sub
        ruta = .SelectedItems(1)
        diag = InStrRev(ruta, "\")
        [B2] = Left(ruta, diag)
        For Each ar In .SelectedItems
            arch = Mid(ar, diag + 1)
            Workbooks.OpenXML Filename:=ar
            y = 1: FolioFiscal = ""
            Do Until Cells(2, y) = ""
                Select Case Trim(Cells(2, y))
                Case "/cfdi:Complemento/tfd:TimbreFiscalDigital/@UUID": FolioFiscal = Cells(3, y)
                Case "/@serie":                                         SERIE = Cells(3, y)
                Case "/@folio":                                         FOLIO = Cells(3, y)
                Case "/cfdi:Receptor/@rfc":                             RECEPTORRFC = Cells(3, y)
                Case "/cfdi:Receptor/@nombre":                          RECEPTORNOMBRE = Cells(3, y)
                Case "/cfdi:Emisor/@rfc":                               EMISORRFC = Cells(3, y)
                Case "/cfdi:Emisor/@nombre":                            EMISORNOMBRE = Cells(3, y)
                Case "/@Moneda":                                        MONEDA = Cells(3, y)
                Case "/@TipoCambio":                                    TIPOCAMBIO = Cells(3, y)
                Case "/@subTotal":                                      Subtotal = Cells(3, y)
                Case "/cfdi:Impuestos/@totalImpuestosRetenidos":        TOTALIMPUESTOSRETENIDOS = Cells(3, y)
                Case "/cfdi:Impuestos/@totalImpuestosTrasladados":      TOTALIMPUESTOSTRASLADADOS = Cells(3, y)
                Case "/@total":                                         Total = Cells(3, y)
                Case "/cfdi:Conceptos/cfdi:Concepto/@descripcion":      CONCEPTO = Cells(3, y)
                Case "/@fecha":                                         FECHA = Cells(3, y)
                Case "/@LugarExpedicion":                               LugarExpedicion = Cells(3, y)
                Case "/@tipoDeComprobante":                             TIPODECOMPROBANTE = Cells(3, y)
                End Select
                y = y + 1
            Loop
            '--
            ActiveWorkbook.Close
            Range("A" & Fila) = arch
            Range("B" & Fila) = FolioFiscal
            Range("C" & Fila) = SERIE
            Range("D" & Fila) = FOLIO
            Range("E" & Fila) = RECEPTORRFC
            Range("F" & Fila) = RECEPTORNOMBRE
            Range("G" & Fila) = EMISORRFC
            Range("H" & Fila) = EMISORNOMBRE
            Range("I" & Fila) = MONEDA
            Range("J" & Fila) = TIPOCAMBIO
            Range("K" & Fila) = Subtotal
            Range("L" & Fila) = TOTALIMPUESTOSRETENIDOS
            Range("M" & Fila) = TOTALIMPUESTOSTRASLADADOS
            Range("N" & Fila) = Total
            Range("O" & Fila) = CONCEPTO
            Range("P" & Fila) = FECHA
            Range("Q" & Fila) = LugarExpedicion
            Range("R" & Fila) = TIPODECOMPROBANTE
            Fila = Fila + 1
        Next
    End With
    '
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub
Mira dependiendo lo que quieras extraer del xml es como le vamos quitando cosas.
Si gustas pasameun ejemplo a mi correo para ver que se le va a quitar y lo hacemos.
[email protected]

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas