×
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

i have a problem with a button sele
2

i have a problem with a button sele

i have a problem with a button sele

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

Dim rutaOrigen As String
rutaOrigen = "D:\Donnees\Invoice\REPAIR_INVOICE\"


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
-------------------------------------------------------------------------------------------------------------

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

RE: i have a problem with a button sele

I would start with something like this:

CODE

Option Explicit

Sub CopiarArchivosFacturas()
' 1. Abrir un archivo de Excel determinado por el usuario
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

''' The rest of your code goes here...

End Sub 

I have never coded in Spanish.... smile

---- Andy

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

RE: i have a problem with a button sele

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


RE: i have a problem with a button sele

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:
Sub CopiarArchivosFacturas() and
Sub CopiarArchivoRecursivo(ByVal ...
but that code could be anywhere in your Excel's VBA

---- Andy

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

RE: i have a problem with a button sele

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

RE: i have a problem with a button sele

OK, so...:
  • Button 1 does (what?)
  • Button 2 does (what?)
  • Button 3 does (what?)

---- Andy

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

RE: i have a problem with a button sele

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

RE: i have a problem with a button sele

I am sorry, we are not communicating. sad
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

RE: i have a problem with a button sele

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


RE: i have a problem with a button sele

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

RE: i have a problem with a button sele

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

RE: i have a problem with a button sele

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

RE: i have a problem with a button sele

(OP)

RE: i have a problem with a button sele

Have you tried to execute the code line by line? Add a break point in Set fso = CreateObject("Scripting.FileSystemObject"), 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

RE: i have a problem with a button sele

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

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