app visual basic excel

[office365]

Dears,

i would like to do some app about copy files from a folder in order to send an another folder but only files are wroten in excel file.

I need help please.

 

[Andrzejek]

What have you done/written so far and where are you stuck?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[office365]

This is the code, but the problem it is the next cuestion : I need to looking for in folder and subfolder the files what are wroten under cell called " Invoice Number" , but the program doesnt looking for in the subfolder and i dont know the reason.





' En Herramientas / Referencias hay que activar "Microsoft Scripting Runtime" para que funcione correctamente


Sub copiarArchivos()

'1. Abrir un archivo Excel determinado por el usuario
Dim filePath As Variant
filePath = Application.GetOpenFilename("Archivos Excel (*.xls*), *.xls*", , "Seleccione el archivo Excel")

If filePath = False Then
MsgBox "No se ha seleccionado ningún archivo"
Exit Sub
End If

Workbooks.Open filePath

'2. Buscar la palabra "facturas" en la hoja de Excel
Dim hoja As Worksheet
Set hoja = ActiveSheet

Dim ultimaFila As Long
ultimaFila = hoja.Cells.SpecialCells(xlCellTypeLastCell).Row

Dim i As Long
Dim j As Long
Dim colFacturas As Long
Dim filFacturas As Long

For i = 1 To ultimaFila
For j = 1 To hoja.Cells(i, Columns.Count).End(xlToLeft).Column
If hoja.Cells(i, j).Value = "facturas" Then
colFacturas = j
filFacturas = i
Exit For
End If
Next j

If colFacturas > 0 Then
Exit For
End If
Next i

If colFacturas = 0 Then
MsgBox "No se ha encontrado la palabra 'facturas' en la hoja de Excel"
Exit Sub
End If

'3. Localizar e indicar en qué columna y fila se encuentra la palabra "facturas"
MsgBox "La palabra 'facturas' se encuentra en la columna " & colFacturas & " y la fila " & filFacturas

'4. Hacer un bucle con los valores COL y FIL como índices del bucle
Dim filaActual As Long
Dim colActual As Long

For filaActual = filFacturas + 1 To ultimaFila
If hoja.Cells(filaActual, colFacturas).Value <> "" Then
colActual = colFacturas + 1

'5. Copiar todos los archivos definidos en las celdas sean carpetas o subcarpetas del origen definido como raíz C:\macro\Origen
Dim rutaOrigen As String
rutaOrigen = "C:\Users\Desktop\origen\"

Dim rutaDestino As String
rutaDestino = "C:\Users\Desktop\destino\"

Do While hoja.Cells(filaActual, colActual).Value <> ""
Dim archivoActual As String
archivoActual = hoja.Cells(filaActual, colActual).Value

Dim rutaArchivoOrigen As String
rutaArchivoOrigen = rutaOrigen & archivoActual

If Dir(rutaArchivoOrigen, vbDirectory) <> "" Then
'Es una carpeta, copiar todos los archivos de la carpeta y sus subcarpetas
Call CopiarArchivosCarpeta(rutaArchivoOrigen, rutaDestino)
Else
'Es un archivo, copiar el archivo
FileCopy rutaArchivoOrigen, rutaDestino & archivoActual
End If

colActual = colActual + 1
Loop
End If
Next filaActual

'7. Copiar los archivos coincidentes en el directorio salida
MsgBox "Se han copiado los archivos correctamente"

End Sub


Sub CopiarArchivosCarpeta(ByValrutaCarpetaOrigen As String, ByVal rutaCarpetaDestino As String)


Dim archivoActual As String
archivoActual = Dir(rutaCarpetaOrigen & "\*.*")

Do While archivoActual <> ""
If archivoActual <> "." And archivoActual <> ".." Then
Dim rutaArchivoOrigen As String
rutaArchivoOrigen = rutaCarpetaOrigen & "\" & archivoActual

If Dir(rutaArchivoOrigen, vbDirectory) <> "" Then
'Es una carpeta, crear la carpeta en el destino y copiar todos los archivos de la carpeta y sus subcarpetas
If Dir(rutaCarpetaDestino & archivoActual, vbDirectory) = "" Then
MkDir rutaCarpetaDestino & archivoActual
End If

Call CopiarArchivosCarpeta(rutaArchivoOrigen, rutaCarpetaDestino & archivoActual & "\")
Else
'Es un archivo, copiar el archivo en el destino
FileCopy rutaArchivoOrigen, rutaCarpetaDestino & archivoActual
End If
End If

archivoActual = Dir
Loop
End Sub

 

[Andrzejek]

I need to looking for in folder and subfolder(s?)

The approach you are looking for is called 'recursive' (the Sub that calls itself).
Here is one example: Loop Through All Subfolders Using VBA
And here is another: Recursive File Listing of Folders

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[office365]

if you want the code, say me , i have it !!! thanks so much