Código que Importe solo archivos xml
Necesito de su apoyo tengo este código, del cual necesito que solo me importe el archivo xml, ya que toma parejo, si tengo en el directorio .xlsx, pdf, etc. Espero me puedan orientar.
Private Sub CommandButton4_Click()
Dim archivo, carpeta, MyFile As String, Sep As String
Dim xx
Dim rutorigen, rutdestino As String
Dim fila, col As Integer
carpeta = "e:\p\"
If carpeta = "" Then
Exit Sub
Else
If Right(carpeta, 1) <> "\" Then
carpeta = carptea & "\"
End If
End If
fila = 1
col = 10
archivo = Dir(carpeta)
Do While Len(archivo) > 0
Hoja7.Cells(fila, col).Value = "E:\p\" & archivo
archivo = Dir()
fin = Hoja1.Range("A" & Rows.Count).End(xlUp).Row
fin2 = Hoja1.Range("A" & Rows.Count).End(xlUp).Row
fin = fin + 1
Hoja1.Cells(fin, 1) = "A" & Hoja7.Cells(2, 1) ' folio
Hoja1.Cells(fin, 2) = Left(Format(Hoja7. Cells(2, 2), "d-mm-yy"), 10) ' fecha
Hoja1.Cells(fin, 3) = Hoja7. Cells(2, 7) ' nombre
Hoja1.Cells(fin, 5) = Val(Hoja7. Cells(2, 3)) ' subtotal
Hoja1.Cells(fin, 6) = Val(Hoja7. Cells(2, 4)) 'iva
Hoja1.Cells(fin, 7) = Val(Hoja7. Cells(2, 5)) ' total
Hoja1.Cells(fin, 19) = Hoja7. Cells(2, 6) ' moneda
If Hoja1.Cells(fin, 19) = "USD" Then
fin2 = Hoja5.Range("A" & Rows.Count).End(xlUp).Row
Hoja1.Cells(fin, 18) = Val(Hoja5.Cells(fin2 - 1, 2) / 1000000)
Hoja1.Cells(fin, 7) = Val(Hoja1.Cells(fin, 5) * Val(Hoja1.Cells(fin, 18)))
Hoja1.Cells(fin, 8) = Val(Hoja7.Cells(2, 3))
Hoja1.Cells(fin, 6) = Empty
End If
cl = Hoja1.Cells(fin, 3)
fin3 = Hoja3.Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To fin3
If cl = Hoja3.Cells(j, 1) Then
Hoja1.Cells(fin, 9) = Val(Hoja3.Cells(j, 2)) ' columna de credito
Hoja1.Cells(fin, 11) = "PENDIENTE"
Hoja1.Cells(fin, 11).Interior.ColorIndex = 6
x = Hoja1.Cells(fin, 9) 'valor de fecha factura
xx = CDate(Hoja1.Cells(fin, 2)) ' formato de fecha
Hoja1.Cells(fin, 10) = DateAdd("d", x, xx) ' agrego dias a fecha
Exit For
End If
Next j
Else
Loop
MsgBox "Se traspasaron " & Z & " facturas", vbInformation
' ---- mover facturas a otra carpeta ------------
'rutorigen = "E:\*.*"
'rutdestino = "E:\p\p
'If tempo(rutorigen) Then
'tempo.movefile rutorigen, rutdestino
'Set tempo = Nothing
'End If
End Sub
1 respuesta
H o l a: Exactamente no sé lo que hace tu macro, pero para leer los archivo xml, realiza estos cambios:
Esta línea:
archivo = Dir(carpeta)
Por esta línea:
archivo = Dir(carpeta & "*.xml")
Esta línea
carpeta = carptea & "\"
Por esta línea:
carpeta = carpeta & "\"
Y antes de la línea Loop borra esta línea:
Else
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias!
Gracias tengo batallando toda la mañana, y la línea de &"*.xml" es la que no sabia donde poner.
Los otros los corregui después de enviártelo.
Se agradece mucho.
Lo que hace es que importa los archivos xml, en una sola línea, en una hoja y después copio los datos que necesito a otra hoja base de ahí hago otros leves calulos y controla pendientes, vencidas, canceladas, pagadas, en un formulario. Y varias consultas a esa base, todo por medio de formularios, pero esto es lo principal.
Saludos.
