i have a problem with a button sele 2

[office365]

i have a problem with a button select, because when i am going to do the buttons in order to join the macro, it gives me an error . Attached the code in vba :



Option Explicit

Sub CopiarArchivosFacturas()
' 1. Abrir un archivo de Excel determinado por el usuario
Dim archivo As Variant
archivo = Application.GetOpenFilename("Archivos de Excel (*.xls*;*.xlsx), *.xls*;*.xlsx")

If TypeName(archivo) = "Boolean" Then Exit Sub ' Si el usuario cancela la selección

Dim wb As Workbook
Set wb = Workbooks.Open(archivo)

' 2. Buscar la palabra "facturas" en la hoja de Excel
Dim hoja As Worksheet
Set hoja = wb.Sheets(1)

Dim palabra As String
palabra = "Invoice Number"

' 3. Localizar e indicar en qué columna y fila se encuentra esa palabra "facturas"
Dim rangoBusqueda As Range
Set rangoBusqueda = hoja.UsedRange

Dim celda As Range
Set celda = rangoBusqueda.Find(palabra)

Dim FIL As Long
Dim COL As Long
FIL = celda.Row
COL = celda.Column

Here the form must to be :

[highlight #CC0000]Dim rutaOrigen As String
rutaOrigen = "D:\Donnees\Invoice\REPAIR_INVOICE\"[/highlight]

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

' 6. Copiar todos los archivos encontrados debajo de la celda facturas y que coincidan con los archivos que hay en tanto carpetas como subcarpetas en el directorio origen
Dim archivoFactura As Range
Dim i As Long

For i = FIL + 1 To hoja.Cells(hoja.Rows.Count, COL).End(xlUp).Row
Set archivoFactura = hoja.Cells(i, COL)
Dim nombreArchivoFactura As String
nombreArchivoFactura = archivoFactura.Value

CopiarArchivoRecursivo rutaOrigen, rutaDestino, nombreArchivoFactura
Next i

' Cerrar el archivo de Excel
wb.Close SaveChanges:=False

MsgBox "Proceso finalizado", vbInformation, "Operación completada"

End Sub

Sub CopiarArchivoRecursivo(ByVal rutaOrigen As String, ByVal rutaDestino As String, ByVal nombreArchivoFactura As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim archivoEncontrado As Object
Dim archivoCopiado As Boolean
archivoCopiado = False

For Each archivoEncontrado In fso.GetFolder(rutaOrigen).Files
If InStr(1, archivoEncontrado.Name, nombreArchivoFactura, vbTextCompare) > 0 Then
Dim newFileName As String
newFileName = archivoEncontrado.Name
Dim counter As Integer
counter = 1
While fso.FileExists(rutaDestino & newFileName)
newFileName = fso.GetBaseName(archivoEncontrado.Name) & "(" & counter & ")." & fso.GetExtensionName(archivoEncontrado.Name)
counter = counter + 1
Wend
fso.CopyFile archivoEncontrado.Path, rutaDestino & newFileName, True
archivoCopiado = True
End If
Next archivoEncontrado

If Not archivoCopiado Then
Dim carpeta As Object
For Each carpeta In fso.GetFolder(rutaOrigen).SubFolders
CopiarArchivoRecursivo carpeta.Path, rutaDestino, nombreArchivoFactura
Next carpeta
End If
End Sub
-------------------------------------------------------------------------------------------------------------

[pre]I need to do some form ,because is te unique form in order to select for the guest[/pre]

 

[Andrzejek]

I would start with something like this:

Option Explicit

Sub CopiarArchivosFacturas()[green]
' 1. Abrir un archivo de Excel determinado por el usuario[/green]
Dim archivo As Variant
Dim FldrPicker As FileDialog
Dim origenFolder As String
Dim destinoFolder As String

archivo = Application.GetOpenFilename("Archivos de Excel (*.xls*;*.xlsx), *.xls*;*.xlsx", , _
    "Seleccione el archivo de Excel para procesar.")

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
    .Title = "Seleccione una carpeta de origen"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    origenFolder = .SelectedItems(1) & "\"
End With
  
MsgBox "Carpeta de origen: " & origenFolder

With FldrPicker
    .Title = "Seleccione la carpeta de destino"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Sub
    destinoFolder = .SelectedItems(1) & "\"
End With
  
MsgBox "Carpeta de destino: " & destinoFolder
[green]
''' The rest of your code goes here...
[/green]
End Sub

I have never coded in Spanish....

---- Andy

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

 

[office365]

it´s no possible for doing how you say me, because the imagen must how i show you in the next :

 

[Andrzejek]

Are you saying you have (or want to have?) a UserForm with 3 command buttons?

Because all what you show here are just 2 Sub's:
[tt]Sub CopiarArchivosFacturas()[/tt] and
[tt]Sub CopiarArchivoRecursivo(ByVal ...[/tt]
but that code could be anywhere in your Excel's VBA

---- Andy

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

 

[office365]

i want to do this Userform with 3 buttons with this code or another code ....

 

[Andrzejek]

OK, so...:
[ul]
[li]Button 1 does (what?)[/li]
[li]Button 2 does (what?)[/li]
[li]Button 3 does (what?)[/li]
[/ul]

---- Andy

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

 

[office365]

Everyone button must to go you until one folder it´s called by itselfs

 

[Andrzejek]

I am sorry, we are not communicating. :-(
On your UserForm you have just 1 Command button (designed to do some action), and 4 Option Buttons (designed to allow you 1 'selection')
Someone else (who speaks Spanish) needs to jump in here to help you.

---- Andy

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

 

[office365]

This code or give me an error o the program takes the exit y it is closed



this is the main code :

Option Explicit

Public gCarpetaOrigen As String

' Previo al 4. Mostrar formulario
Function MostrarFormulario() As Boolean
Dim frm As New UserForm1
frm.Show vbModal
gCarpetaOrigen = frm.CarpetaOrigen
If Len(gCarpetaOrigen) > 0 Then
MostrarFormulario = True
Else
MostrarFormulario = False
End If
End Function

Sub CopiarArchivosFacturas()

If Not MostrarFormulario Then Exit Sub

' 1. Abrir un archivo de Excel determinado por el usuario
Dim archivo As Variant
archivo = Application.GetOpenFilename("Archivos de Excel (.xls;.xlsx), .xls;.xlsx")


If TypeName(archivo) = "Boolean" Then Exit Sub ' Si el usuario cancela la selección

Dim wb As Workbook
Set wb = Workbooks.Open(archivo)

' 2. Buscar la palabra "facturas" en la hoja de Excel
Dim hoja As Worksheet
Set hoja = wb.Sheets(1)

Dim palabra As String
palabra = "Invoice Number"

' 3. Localizar e indicar en qué columna y fila se encuentra esa palabra "facturas"
Dim rangoBusqueda As Range
Set rangoBusqueda = hoja.UsedRange

Dim celda As Range
Set celda = rangoBusqueda.Find(palabra)

Dim FIL As Long
Dim COL As Long
FIL = celda.Row
COL = celda.Column


' 4. Utilizar la selección del usuario como carpeta de origen

Dim rutaOrigen As String
Dim seleccionUsuario As String
seleccionUsuario = gCarpetaOrigen

Select Case seleccionUsuario
Case "A"
rutaOrigen = "C:\A\"
Case "B"
rutaOrigen = "C:\B\"
Case "C"
rutaOrigen = "C:\C\"
Case "TODOS"
rutaOrigen = "C:\"
Case Else
MsgBox "Opción de carpeta de origen no válida.", vbCritical, "Error"
Exit Sub
End Select


' 5. Pedir al usuario que seleccione la carpeta de destino


Dim rutaDestino As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")


With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Seleccione la carpeta de destino"
.InitialFileName = "C:\"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Debe seleccionar una carpeta de destino.", vbCritical, "Error"
Exit Sub
Else
rutaDestino = .SelectedItems(1) & "\"
End If
End With

' 6. Copiar todos los archivos encontrados debajo de la celda facturas y que coincidan con los archivos que hay en tanto carpetas como subcarpetas en el directorio origen
Dim archivoFactura As Range
Dim i As Long

For i = FIL + 1 To hoja.Cells(hoja.Rows.Count, COL).End(xlUp).Row
Set archivoFactura = hoja.Cells(i, COL)
Dim nombreArchivoFactura As String
nombreArchivoFactura = archivoFactura.Value

CopiarArchivoRecursivo rutaOrigen, rutaDestino, nombreArchivoFactura, fso
Next i

' Cerrar el archivo de Excel
wb.Close SaveChanges:=False

MsgBox "Proceso finalizado", vbInformation, "Operación completada"
End Sub


Sub CopiarArchivoRecursivo(ByVal rutaOrigen As String, ByVal rutaDestino As String, ByVal nombreArchivoFactura As String, ByRef fso As Object)
Dim archivoEncontrado As Object
Dim archivoCopiado As Boolean
archivoCopiado = False

For Each archivoEncontrado In fso.GetFolder(rutaOrigen).Files
If InStr(1, archivoEncontrado.Name, nombreArchivoFactura, vbTextCompare) > 0 Then
Dim newFileName As String
newFileName = archivoEncontrado.Name
Dim counter As Integer
counter = 1
While fso.FileExists(rutaDestino & newFileName)
newFileName = fso.GetBaseName(archivoEncontrado.Name) & "(" & counter & ")." & fso.GetExtensionName(archivoEncontrado.Name)
counter = counter + 1
Wend
fso.CopyFile archivoEncontrado.Path, rutaDestino & newFileName, True
archivoCopiado = True
End If
Next archivoEncontrado

If Not archivoCopiado Then
Dim carpeta As Object
For Each carpeta In fso.GetFolder(rutaOrigen).SubFolders
CopiarArchivoRecursivo carpeta.Path, rutaDestino, nombreArchivoFactura, fso
Next carpeta
End If
End Sub


And the form code is :


Option Explicit

Private Sub ComboBox1_Change()

End Sub

Private Sub UserForm_Initialize()
With Me.ComboBox1
.AddItem "a"
.AddItem "b"
.AddItem "c"
.AddItem "TODOS"
End With
End Sub

Private Sub CommandButton1_Click()
If Me.ComboBox1.ListIndex < 0 Then
MsgBox "Por favor, seleccione una opción de carpeta de origen.", vbCritical, "Error"
Exit Sub
End If

' CopiarArchivosFacturas (Eliminar esta línea)
Unload Me
End Sub

Public Property Get CarpetaOrigen() As String
CarpetaOrigen = ComboBox1.Value
End Property

Private Sub CommandButtonAceptar_Click()
Me.Hide
End Sub

 

[combo]

You have no 'On Error...' statement, so for testing you can set your VBE (Tools>Options dialog, 'General' tab) to notify before state loss and breakon unhandled errors.
You can execute your code line by line (add a breakpoint at the start of tested code, after break execute line by line, from 'Debug' toolbar). At least you will be eble to locate where the problem is. I had a problem with scripting when i declared FSO and File at module level (Dim FSO As Scripting.Filesystemobject). Excel was closed without warning.

Is there a reason that you hide the form (Me.Hide, last procedure) instead of unloading?

combo

 

[office365]

You have no 'On Error...' statement, so for testing you can set your VBE (Tools>Options dialog, 'General' tab) to notify before state loss and breakon unhandled errors.

You can execute your code line by line (add a breakpoint at the start of tested code, after break execute line by line, from 'Debug' toolbar). At least you will be eble to locate where the problem is. I had a problem with scripting when i declared FSO and File at module level (Dim FSO As Scripting.Filesystemobject). Excel was closed without warning.
Ok, but i dont want to take more time .

Is there a reason that you hide the form (Me.Hide, last procedure) instead of unloading?

i dont know . i see the solution in another forum.

​

 

[combo]

The image is hard to read. ALT+PrtSc will copy only the message.
When the runtime error occurs, have you VBE options set as in my post above?
Is it the line with error marked (yellow)?

combo

 

[office365]

 

[combo]

Have you tried to execute the code line by line? Add a break point in [tt]Set fso = CreateObject("Scripting.FileSystemObject")[/tt], next execute line by line when you reach theis line. You may have problems with fso or other scripting objects.

NB: it's ok to hide the form, it allows to run the rest of main procedure and read public variable.

combo

 

[office365]

Have you tried to execute the code line by line?
Yes but it's always is stopped and saying me the error that i show you

Now i dontn know that I can do with the code, I dont find exit for resolving the problem

NB: it's ok to hide the form, it allows to run the rest of main procedure and read public variable.

 

[combo]

Try to execute the code with the VBE settings I suggested, maybe you will find the line with error.
I would rather declare global FSO, as Scripting.Filesystem object, with reference to scripting. Examples of recursive calls in file system tree can be found in Chip Pearson site, as

http://www.cpearson.com/Excel/RecursionAndFSO.htm

or

http://www.cpearson.com/excel/QuickTree.aspx

combo