En este caso lo mejor sería crear una función a la que le pasas los parámetros:
Función:
Function copiarPorExtension(sFolderOrigen, sFolderDestino, sExtension)
For Each sFile In oFSO.GetFolder(sFolderOrigen).Files
If LCase(oFSO.GetExtensionName(sFile)) = sExtension Then
If Not oFSO.FileExists(sFolderDestino & "\" & oFSO.GetFileName(sFile)) Then
oFSO.GetFile(sFile).Copy sFolderDestino & "\" & oFSO.GetFileName(sFile),True
End If
End If
Next
End Function
Preparar los parámetros y llamar la función desde cualquier parte
Dim sOrigen, sDestino, sExtension, dtmValue, sFecha, sHora
sOrigen = "C:\rutaA\"
'Para obtener la fecha
'Almacenaré la fecha en la variable sFecha y la hora en la variable sHora
'En el ejemplo se crea el nombre de carpeta con la fecha, si quieres que tenga la hora le agregas la variable sHora
dtmValue = Now()
sFecha = Year(dtmValue)"_" & Month(dtmValue) & "_" & Day(dtmValue)
sHora = strDate & "\" & Hour(dtmValue) & "-" & Minute(dtmValue) & "-" & Second(dtmValue)
sDestino = "C:\ruta_final" & sFecha
sExtension = "html"
'Llamamos la función pasándole los parámetros
Call copiarPorExtension(sOrigen, sDestino, sExtension)
La ventaja de la función es que, en el caso de querer pasar otros parámetros, como trabajar con archivos de extensión txt, doc u otros o con directorios distintos, no necesitas cambiar todo el código, sino solamente los parámetros que pasas a la función.
Si son varios directorios de origen
Se crea un array con los nombres de los directorios y se pasa como parámetro.
Nótese que la función copiarPorExtension ()
quedaría modificada, ya que recibirá como primer parámetro un array, en lugar de una cadena, por eso el primer parámetro se llama ahora arrOrigenes()
donde las () indican que se trata de un array.
Luego, tendrá otro bucle for donde irá leyendo las diferentes carpetas de origen que recibió en parámetro, donde arrOrigenes(i)
irá tomando la ruta de los folders existentes en el array (LaRutadelFolder1, LaRutadelFolder2, etc).
Nota: Aquí solo modifico el valor de arrFoldersOrigen
, los demás valores se declararían tal y como aparece más arriba.
Dim arrFoldersOrigen
arrFoldersOrigen = Array ("LaRutadelFolder1","LaRutadelFolder2","LaRutadelFolder3")
i=0
Para llamar la función:
Call copiarPorExtension
(arrFoldersOrigen,
sDestino, sExtension)
Function copiarPorExtension(arrOrigenes(), sFolderDestino, sExtension)
For i=0 to ubound(arrOrigenes)
For Each sFile In oFSO.GetFolder(arrOrigenes(i)).Files
If LCase(oFSO.GetExtensionName(sFile)) = sExtension Then
If Not oFSO.FileExists(sFolderDestino & "\" & oFSO.GetFileName(sFile)) Then
oFSO.GetFile(sFile).Copy sFolderDestino & "\" & oFSO.GetFileName(sFile),True
End If
End If
Next
Next
End Function
Como detalle y aclaración:
Lo mismo se podría hacer si se desea pasar varias extensiones, se crea un array de extensiones y se le pasa a la función. Entonces habría que crear otro bucle for dentro de cada folder para que busque las extensiones pasadas en el array.