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
-------------------------------------------------------------------------------------------------------------
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
CODE
I have never coded in Spanish....
---- Andy
"Hmm...they have the internet on computers now"--Homer Simpson
RE: i have a problem with a button sele
RE: i have a problem with a button sele
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
RE: i have a problem with a button sele
---- Andy
"Hmm...they have the internet on computers now"--Homer Simpson
RE: i have a problem with a button sele
RE: i have a problem with a button sele
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