Importar un numero de 37 caracteres como texto desde un archivo .xml a Excel mediante una macro.

Cordiales a todos.

Deseo importar varios archivos .xml a una hoja de excel mediante una macro, este es el código.

Sub Extraerdatos()
Dim MiPc, Carpeta, Archivos, Archivo
Dim Fila
Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Carpeta = MiPc.GetFolder(Range("B1").Value)
Set Archivos = Carpeta.Files
For Each Archivo In Archivos
    If LCase(Right(Archivo.Name, 4)) = ".xml" Then
        Workbooks.OpenXML Filename:=Archivo
        fecha = Left(Cells(3, 4), 10)
        nAutorizacion = Cells(3, 6) 'ESTE ES EL DATO QUE SE IMPORTA INCOMPLETO
        Archivo = ActiveWorkbook.Name
        ActiveWorkbook.Close
        Range("A" & Fila) = Archivo
        Range("B" & Fila) = fecha
        Range("C" & Fila) = "" & nAutorizacion
      End If
   Archivo = "": fecha = "": nAutorizacion = ""
   Fila = Fila + 1
Next
End Sub

El problema surge al momento de importar un numero de 37 dígitos que por defecto lo transforma a u numero científico y se pierden muchos caracteres de este dato. (Lo marcado en rojo es como necesito importarlo)

Además adjunto el código del archivo xml.
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<autorizacion>
<estado>AUTORIZADO</estado>
<numeroAutorizacion>0104201616390809908583220015763237938</numeroAutorizacion>
<fechaAutorizacion>2016-04-01T16:39:08-05:00</fechaAutorizacion>
<ambiente>PRODUCCIÓN</ambiente>
<comprobante>E</comprobante>
<mensajes/>
</autorizacion>

1 Respuesta

Respuesta
1

Prueba con lo siguiente:

Sub Extraerdatos()
'Act.Por.Dante Amor
    Dim MiPc, Carpeta, Archivos, Archivo
    Dim Fila
    '
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set MiPc = CreateObject("Scripting.FileSystemObject")
    Set Carpeta = MiPc.GetFolder(Range("B1").Value)
    Set Archivos = Carpeta.Files
    For Each Archivo In Archivos
        If LCase(Right(Archivo.Name, 4)) = ".xml" Then
            Workbooks.OpenXML Filename:=Archivo, LoadOption:=xlXmlLoadImportToList
            fecha = Left(Cells(1, 3), 10)
            nAutorizacion = Cells(1, 2)
            ActiveWorkbook.Close
            Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
            Range("A" & Fila) = Mid(Archivo, InStrRev(Archivo, "\") + 1)
            Range("B" & Fila) = fecha
            Range("C" & Fila) = "'" & nAutorizacion
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

¡Gracias!   Se soluciono el problema!!!!!!!!!  esto era lo que necesitaba. 

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas