Tengo una base de datos de números telefónicos y tengo una carpeta con algunos archivos de excel nombrados con algunos números telefónicos. Quiero mover esos archivos a otra carpeta.
Actualmente en un rango de celda del documento en excel
tengo los numeros telefónicos y este código es el que utilizo en el visual basic
, pero me marca error.
¿Qué podría ser el error?
¿Cómo escribo las rutas y/o código?
Sub MoverArchivos()
Dim carpetaOrigen As String
Dim carpetaDestino As String
Dim telefonos As Variant
Dim telefono As Variant
Dim nombreArchivo As String
Dim rutaArchivo As String
Dim rutaDestino As String
' Carpeta donde se encuentran los archivos originales
carpetaOrigen = "C:\ArchivosOrigen\"
' Carpeta donde se moverán los archivos que coincidan con los números telefónicos
carpetaDestino = "C:\ArchivosDestino\"
' Rango de celdas donde se encuentran los números telefónicos
telefonos = Range("A1:A10").Value ' Modifica el rango según tu caso
' Recorrer la carpeta de archivos
rutaArchivo = carpetaOrigen & "*.*"
nombreArchivo = Dir(rutaArchivo)
Do While nombreArchivo <> ""
' Obtener el nombre de archivo sin la extensión
nombreArchivo = Left(nombreArchivo, InStrRev(nombreArchivo, ".") - 1)
' Buscar coincidencias con los números telefónicos
For Each telefono In telefonos
If nombreArchivo = telefono Then
' Mover el archivo a la nueva carpeta
rutaDestino = carpetaDestino & nombreArchivo & ".xlsx"
FileCopy carpetaOrigen & nombreArchivo & ".xlsx", rutaDestino
Kill carpetaOrigen & nombreArchivo & ".xlsx"
Exit For
End If
Next telefono
' Obtener el siguiente archivo de la carpeta de origen
nombreArchivo = Dir
Loop
MsgBox "Proceso finalizado."
End Sub