Código de búsqueda en segundo plano VB para copiar archivos con sufijos fijos en un disco USB a un directorio fijo
Este es el código para copiar todos los tipos de archivos .rar/.zip/.doc/.xsl/.xlsx en la unidad G. Sus etiquetas deben ser claramente visibles.
Función privada Buscar archivos (ruta como cadena, tipo de archivo como cadena)
En caso de error, reanudar siguiente
¿Atenuar archivos()? Como cadena 'Ruta del archivo
Dim Folder() As String 'Ruta de la carpeta
Dim a, b, c As Long
Dim sPath As String
Si es correcto (Ruta , 1)lt;gt; "\" Luego Ruta = Ruta amp "\"
sPath = Dir(Path amp. FileType) 'Buscar la ruta del archivo FileType) 'Buscar el primer archivo
Do While Len(sPath) 'Recorre hasta que no queden archivos
a = a 1
ReDim Preserve Files(1 To a)
Files(a) = Path & sPath 'Combina el directorio de archivos y el nombre del archivo y colócalos en una matriz
List1.AddItem Files(a) 'Agregar a la lista de control
sPath = Dir 'Busca el siguiente archivo
DoEvents 'Control de rendimiento
Bucle
sPath = Dir(Ruta amp; "\", vbDirectory) 'Encuentra el primero carpeta
Hacer While Len(sPath) 'Recorrer hasta que no queden carpetas
If Left(sPath , 1) lt;gt "."Entonces 'Para evitar búsquedas duplicadas
p>Si GetAttr(Path & "\" & sPath) y vbDirectory Entonces 'Si es una carpeta, entonces. . . . . .
b = b 1
Carpeta de conservación ReDim (1 a b)
Carpeta (b) = Ruta amp; y el nombre de la carpeta para formar un nuevo directorio y almacenarlo en una matriz
End If
End If
sPath = Dir 'Buscar la siguiente carpeta
DoEvents 'Generar control
Bucle
For c = 1 To b 'Usar recursividad para recorrer todos los directorios
SearchFiles Carpeta(c), Tipo de archivo
Siguiente
For c = 1 To b 'Utilice la recursividad para recorrer todos los directorios
Buscar carpeta de archivos (c), tipo de archivo
Siguiente
Función final
Subcomando privado1_Click()
Buscar archivos "G. /", "*:\", "*.rar" 'Especificar tipo rar
SearchFiles "G:\", "*.zip" 'Especifica el tipo ZIP
SearchFiles "G:\", "*.doc" 'Especifica el tipo DOC
SearchFiles "G:\", "*.xsl" 'Especifica el tipo XLS
SearchFiles "G:\", "*.xslx" 'Especifica el tipo XLSX
End Sub
Private Sub Command2_Click()
Establecer fso = CreateObject("scripting.filesystemobject")
Establecer ws = CreateObject(" wscript. shell")
¿En caso de error, reanudar a continuación? Tolerancia de error
Para i = 0 a List1.ListCount - 1?'Obtener el número de archivos
a = List1. List(i) 'Especifique la ruta al archivo
t = Split(a, "\") 'Divida la ruta del archivo en \
s = UBound(t) 'Obtener el valor máximo de la división
J = t(s) 'Obtener el nombre del archivo
FileCopy a, "F:\New Folder\" amp J?Copiar archivo
Siguiente
End Sub Adjunto es el código fuente