×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

app visual basic excel

app visual basic excel

app visual basic excel

(OP)
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.

RE: app visual basic excel

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

---- Andy

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

RE: app visual basic excel

(OP)
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

RE: app visual basic excel

Quote (office365)

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

RE: app visual basic excel

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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login


Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close