Excluding files from Purge

[rhino4eva]

Sub Autpen()

Dim FolderPath As String, path As String, NumOfFiles As Integer

If MsgBox("Do you need to change the age limit ?", vbYesNo + vbQuestion) = vbYes Then End

For x = 1 To Sheets("Sheet1").Range("f1")
Dir_Path = Sheets("Sheet1").Range("g" & x + 1)
Set imaxage = Sheets("Sheet1").Range("d1") ' changeable number of days
Set oFSO = CreateObject("Scripting.FileSystemObject")

MsgBox "Inspecting " & Dir_Path & " for antique files"

path = FolderPath & "\*.*"
Filename = Dir(path)
Do While Filename <> ""
Filename = Dir()
Loop

If oFSO.FolderExists(Dir_Path) Then 'Check that the folder exists
For Each ofile In oFSO.GetFolder(Dir_Path).Files
If DateDiff("d", ofile.DateLastModified, Now) > imaxage Then 'Look at each file to check if it is older than 10 days
age = DateDiff("d", ofile.DateLastModified, Now) ' calculate the age
'If age > 150 Then End
If MsgBox("Delete " & ofile & " because its " & age & " old", vbYesNo + vbQuestion) = vbYes Then ' do yo weant to delete it



ofile.Delete
Else: End If

End If
Next
End If
Next x


End Sub

so i have a piece of vba code to search thru a list of directories (column G) and delete files older than 10 days old
however i would like to save certain files whose age is greater that 10 days,these are listed in column I
instead of "ending " as i have it now , how would i be able to weave a "do not delete is in this list(I) " into the code

 

[Rijnsent]

Hi, firstly: can you please use some markup when you post a question? Another good practice, first ask your question, post your VBA after that. That makes the question much more readable and easier to answer. Something like this coudl work (untested):

Sub Auto_Open()

Dim FolderPath As String, path As String, NumOfFiles As Integer

Set imaxage = Sheets("Sheet1").Range("d1") ' changeable number of days
If MsgBox("Do you need to change the age limit (currently: " & imaxage & ") ?", vbYesNo + vbQuestion) = vbYes Then End

KeepFileList = Sheets("Sheet1").Range("I2:I10").Value

For x = 1 To Sheets("Sheet1").Range("f1")
    
    Dir_Path = Sheets("Sheet1").Range("g" & x + 1)
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    MsgBox "Inspecting " & Dir_Path & " for antique files"
    
    If oFSO.FolderExists(Dir_Path) Then 'Check that the folder exists
        For Each ofile In oFSO.GetFolder(Dir_Path).Files
            If DateDiff("d", ofile.DateLastModified, Now) > imaxage Then 'Look at each file to check if it is older than 10 days
                KeepFile = False
                For i = LBound(KeepFileList) To UBound(KeepFileList)
                    If KeepFileList(i) = ofile.Name Then
                        KeepFile = True
                        Exit For
                    End If
                Next i
                If KeepFile = False Then
                    age = DateDiff("d", ofile.DateLastModified, Now) ' calculate the age
                    'If age > 150 Then End
                    If MsgBox("Delete " & ofile & " because its " & age & " old", vbYesNo + vbQuestion) = vbYes Then ' do yo weant to delete it
                        ofile.Delete
                    Else: End If
                End If
            End If
        Next
    End If
Next x

End Sub

 

[rhino4eva]

Hi, firstly: can you please use some markup when you post a question? Another good practice, first ask your question, post your VBA after that. That makes the question much more readable and easier to answer. Something like this coudl work (untested):

Sub Auto_Open()

Dim FolderPath As String, path As String, NumOfFiles As Integer

Set imaxage = Sheets("Sheet1").Range("d1") ' changeable number of days
If MsgBox("Do you need to change the age limit (currently: " & imaxage & ") ?", vbYesNo + vbQuestion) = vbYes Then End

KeepFileList = Sheets("Sheet1").Range("I2:I10").Value

For x = 1 To Sheets("Sheet1").Range("f1")
  
    Dir_Path = Sheets("Sheet1").Range("g" & x + 1)
    Set oFSO = CreateObject("Scripting.FileSystemObject")
  
    MsgBox "Inspecting " & Dir_Path & " for antique files"
  
    If oFSO.FolderExists(Dir_Path) Then 'Check that the folder exists
        For Each ofile In oFSO.GetFolder(Dir_Path).Files
            If DateDiff("d", ofile.DateLastModified, Now) > imaxage Then 'Look at each file to check if it is older than 10 days
                KeepFile = False
                For i = LBound(KeepFileList) To UBound(KeepFileList)
                 [COLOR=rgb(209, 72, 65)]   If KeepFileList(i) = ofile.Name Then[/COLOR]
                        KeepFile = True
                        Exit For
                    End If
                Next i
                If KeepFile = False Then
                    age = DateDiff("d", ofile.DateLastModified, Now) ' calculate the age
                    'If age > 150 Then End
                    If MsgBox("Delete " & ofile & " because its " & age & " old", vbYesNo + vbQuestion) = vbYes Then ' do yo weant to delete it
                        ofile.Delete
                    Else: End If
                End If
            End If
        Next
    End If
Next x

End Sub
[/QUOTE]

I see where you are goinf but it debugs at "If KeepFileList(i) = ofile.Name Then"

 

[Joe4]

Instructions for posting VBA code can be found here: How to Post Your VBA Code
It is really quite simple -- just select your whole code block after pasting and click on the VBA icon in the edit tool bar.