Espero me puedan apoyar pues ya tengo 2 dias trabajando con macros para archvos xml, ya he generado las siguientes macros .
La primera convierte los archivos XML en XLS, la segunda abre los archivos ya generados y la ultima junta en una sola hoja toda la informacion de cada archivo ya convertido en XLS.
MI PROBLEMA RADICA QUE CUANDO ME GENERA LOS ARCHIVOS XLS ME MANDA VENTANA DE GUARDAR COMO EL PROBLEMA ES QUE MANEJO APROX DE ENTRE 1800 A 6000 FACTURAS POR DIA.
Cuando corro la macro me pregunta Guardar como y los nombres de los archivos que se generean de los XML toman por defaul el nompre del archivo original del XML ejemplo si mi archivo se llama D0E1AD2C-146C-4F98-B60C-8F0FD02D5EF3 el archivo que se genera de excel toma el sig nombre Copy of D0E1AD2C-146C-4F98-B60C-8F0FD02D5EF3 pero como reitero me manda la ventana de Guardar como.
No quiero que me este preguntando Guardar Como por cada XML que es convertido a XML.
Sub abrir_archivos()
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path
ChDir ("C:\Users\FERNANDO-MUÑOZ\Desktop\Del 10 al 16")
archi = Dir("*.xml*")
On Error Resume Next
If archi = "" Then
MsgBox ("No hay archivos xml en la carpeta " & "(" & ruta & ")" & " para extraer información"), vbExclamation
Buenos dias estimados.
Espero me puedan apoyar pues ya tengo 2 dias trabajando con macros para archvos xml, ya he generado las siguientes macros .
La primera convierte los archivos XML en XLS, la segunda abre los archivos ya generados y la ultima junta en una sola hoja toda la informacion de cada archivo ya convertido en XLS.
MI PROBLEMA RADICA QUE CUANDO ME GENERA LOS ARCHIVOS XLS ME MANDA VENTANA DE GUARDAR COMO EL PROBLEMA ES QUE MANEJO APROX DE ENTRE 1800 A 6000 FACTURAS POR DIA.
Cuando corro la macro me pregunta Guardar como y los nombres de los archivos que se generean de los XML toman por defaul el nompre del archivo original del XML ejemplo si mi archivo se llama D0E1AD2C-146C-4F98-B60C-8F0FD02D5EF3 el archivo que se genera de excel toma el sig nombre Copy of D0E1AD2C-146C-4F98-B60C-8F0FD02D5EF3 pero como reitero me manda la ventana de Guardar como.
No quiero que me este preguntando Guardar Como por cada XML que es convertido a XML.
Sub abrir_archivos()
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path
ChDir ("C:\Users\FERNANDO-MUÑOZ\Desktop\Del 10 al 16")
archi = Dir("*.xml*")
On Error Resume Next
If archi = "" Then
MsgBox ("No hay archivos xml en la carpeta " & "(" & ruta & ")" & " para extraer información"), vbExclamation
Exit Sub
Else
X = 0
Do While archi <> ""
Workbooks.Open archi
Cells.Find(What:="UUID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
identificador = ActiveCell.Value
Cells.Find(What:="@folio", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
folio = ActiveCell.Value
Cells.Find(What:="cfdi:Emisor/@rfc", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
rfc = ActiveCell.Value
Cells.Find(What:="cfdi:Emisor/[uSER=151795]@nombre[/uSER]", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
emisor = ActiveCell.Value
Windows("Extraccion_datos").Activate
Range("A2").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = emisor
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = rfc
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = folio
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = identificador
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ruta & "\" & archi
Workbooks(archi).Close
archi = Dir()
X = X + 1
Loop
Application.ScreenUpdating = True
MsgBox ("Se han extraido los datos de " & X & " archivos exitosamente"), vbInformation
End If
End Sub
Sub Open_Files()
Dim Hoja As Object
Application.ScreenUpdating = False
'Definir la variable como tipo Variante
Dim X As Variant
'Abrir cuadro de dialogo
X = Application.GetOpenFilename _
("Excel Files (*.xlsx), *.xlsx", 2, "Abrir archivos", , True)
'Validar si se seleccionaron archivos
If IsArray(X) Then ' Si se seleccionan
'Crea Libro nuevo
Workbooks.Add
'Captura nombre de archivo destino donde se grabaran los archivos seleccionados
A = ActiveWorkbook.Name
'*/********************
For y = LBound(X) To UBound(X)
Application.StatusBar = "Importando Archivos: " & X(y)
Workbooks.Open X(y)
b = ActiveWorkbook.Name
For Each Hoja In ActiveWorkbook.Sheets
Hoja.Copy After:=Workbooks(A).Sheets(Workbooks(A).Sheets.Count)
Next
Workbooks(
.Close False
Next
Application.StatusBar = "Listo"
Call Unir_Hojas
End If
Application.ScreenUpdating = False
End Sub
Sub Unir_Hojas()
Dim Sig As Byte, Eliminar As Boolean
For Sig = 2 To Worksheets.Count
Worksheets(Sig).UsedRange.Copy _
Worksheets(1).Range("a1000000").End(xlUp).Offset(1)
Next
Application.DisplayAlerts = False
For Sig = 2 To Worksheets.Count
Worksheets(2).Delete
Next
Application.DisplayAlerts = True
End Sub
ELIMINAR ELEMENTOS REPETIDOS
Sub EliminarFilas()
Dim objDic As Object, i As Integer
Set objDic = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
i = 2
Do While Cells(i, "A") <> ""
'Ajustar a columna criterio, en este ejemplo las columna criterio son
'las columnas A, B y D.
If Not objDic.Exists(Cells(i, "A") & Cells(i, "B") & Cells(i, "D")) Then
objDic.Add Cells(i, "A") & Cells(i, "B") & Cells(i, "D"), 1
i = i + 1
Else
Rows(i).EntireRow.Delete
End If
Loop
Set objDic = Nothing
Application.ScreenUpdating = True
End Sub