Foro de elhacker.net

Hola a todos

Necesito copiar carpetas mas antiguas de x dias dentro de una carpeta, hacia otra carpeta por tareas de mantenimiento.

Hago este scrpit pero no me encuentra nada en oSubFolders, y tiene la ruta correcta en ofolder.

Da error en esta linea (Ruta de acceso no encontrada):
   fso.GetFolder(sfolder).Copy sCustomerPicturesPath

Root=C:\Users\Mycomputer\Documents\SD2
MaxAgeInDays=2


Function MoveDeleteOldFolders(Root,MaxAgeInDays)

    Dim fso, sfolder, ofolder, oSubFolders
    Set fso = CreateObject ("Scripting.FileSystemObject")

    If fso.FolderExists(Root) Then

        Set ofolder = fso.GetFolder(Root)
        Set oSubFolders = ofolder.SubFolders
        Set sfolder = Nothing
        On Error Resume Next
        Err.clear

        For Each sfolder in oSubFolders
             If Err.Number <> 0 Then Exit For 'If no permission or no subfolder in folder
             On Error goto 0
            createdDate = FormatDateTime(sfolder.DateCreated, "2")   
            If (DateDiff("d", createdDate, Date) > MaxAgeInDays) Then
                fso.GetFolder(sfolder).Copy sCustomerPicturesPath
                fso.DeleteFolder sfolder, True
            End If
        Next
    End If
End Function

No se donde tengo el fallo.

Gracias por adelantado.

Corrigo, funciona perfectamente hasta esta linea:
      fso.MoveFolder sfolder.path,sCustomerPicturesPath

Aqui me da error de acceso denegado.

sCustomerPicturesPath es una caprpeta de mi propio ordenador, no deberia denegar el acceso.


Function MoveDeleteOldFolders(Root,MaxAgeInDays)


    Dim fso, sfolder, ofolder, oSubFolders
    Set fso = CreateObject ("Scripting.FileSystemObject")

    If fso.FolderExists(Root) Then

        Set ofolder = fso.GetFolder(Root)
        Set oSubFolders = ofolder.SubFolders
        Set sfolder = Nothing

       On Error Resume Next
       Err.clear

        For Each sfolder in oSubFolders
           If Err.Number <> 0 Then
            ESAHMI.ESAMSGBOX Err.Number
            Exit For 'If no permission or no subfolder in folder
         End If
           On Error goto 0
         createdDate = FormatDateTime(sfolder.DateCreated, "2")         'Getting folder date 2 = vbShortDate - Returns date: mm/dd/yyyy

            If (DateDiff("d", createdDate, Date) > MaxAgeInDays) Then
      fso.MoveFolder sfolder.path,sCustomerPicturesPath
                 fso.DeleteFolder sfolder.path, True
           End If
        Next
   Else
      AppendLog("WARNING" &chr(9) &"DataMaintenance: " &chr(9) &"Data _
                maintenance not done, folder doesn't exist. " &Root)
    End If

    Set fso = Nothing
    Set ofolder = Nothing
    Set oSubFolders= Nothing
    Set sfolder = Nothing
End Function

Solucionado, no se puede mover una capeta si esta en C: sin permisos de administrador, la he copiado primero y despues la borro y funciona correctamente.

Un saludo