Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Brisanje fajlova po datumu modifikacije

[es] :: Access :: Brisanje fajlova po datumu modifikacije

[ Pregleda: 1551 | Odgovora: 1 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

ombrs.do
Ristic Aleksandar
Administrator

Član broj: 170168
Poruke: 140
*.teol.net.



Profil

icon Brisanje fajlova po datumu modifikacije25.02.2016. u 12:11 - pre 98 meseci
Pozdrav
Imam kod

Option Explicit
Function Bris()


Dim oFSO, oFolder, sDirectoryPath
Dim oFileCollection, oFile, sDir
Dim iDaysOld

' Specify Directory Path From Where You want to clear the old files'

sDirectoryPath = "C:\SERVER\Laboratorija"

' Specify Number of Days Old File to Delete

iDaysOld = 15

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.files

For Each oFile In oFileCollection

'This section will filter the log file as I have used for for test case
'Specify the Extension of file that you want to delete
'and the number with Number of character in the file extension

If LCase(right(CStr(oFile.Name), 3)) = "doc" Then

If oFile.DateLastModified < (Date - iDaysOld) Then
oFile.Delete (True)
End If

End If
Next

Set oFSO = Nothing
Set oFolder = Nothing
Set oFileCollection = Nothing
End Function

Koji brise fajlove iz foldera Laboratorija.
Moj problem je sto zelim izbrisati sve fajlove koji se nalaze u subfolderima datog foldera Laboratorija.Subfoldera ima oko 5000.
Hvala unaprijed
 
Odgovor na temu

ombrs.do
Ristic Aleksandar
Administrator

Član broj: 170168
Poruke: 140
*.teol.net.



Profil

icon Re: Brisanje fajlova po datumu modifikacije25.02.2016. u 13:32 - pre 98 meseci
Rijesio sam pa da napisem

Option Compare Database

Option Explicit
Sub DirWalk(parmPath)
' Declare basic objects
Dim wshFSO: Set wshFSO = CreateObject("Scripting.FileSystemObject")
Dim wshShell: Set wshShell = CreateObject("WScript.Shell")
Dim wshSysEnv: Set wshSysEnv = wshShell.Environment
Dim wshUsrEnv: Set wshUsrEnv = wshShell.Environment("User")
Dim wshPrcEnv: Set wshPrcEnv = wshShell.Environment("Process")
Dim iDaysOld
iDaysOld = 15

Dim fso, sExtToDelete
Dim nCount
sExtToDelete = Array(".avi", ".mp3", ".mpg", ".mpeg", ".bak", ".wma", ".divx", ".wmv", ".ram", ".rm", ".mpe", ".dot")

nCount = 0
Set fso = CreateObject("Scripting.FileSystemObject")

Dim oSubDir, oSubFolder, oFile, n
Dim bDeleted

On Error Resume Next
Set oSubFolder = fso.getfolder(parmPath)
For Each oFile In oSubFolder.files
If Err.Number = 0 Then
bDeleted = False
For n = 0 To UBound(sExtToDelete)
If LCase(right(oFile.Name, Len(sExtToDelete(n)))) = sExtToDelete(n) Then
If oFile.DateLastModified < (Date - iDaysOld) Then
fso.DeleteFile oFile.path, True
End If
nCount = nCount + 1
bDeleted = True
Exit For
End If
Next
Else
Err.Clear
End If

Next
For Each oSubDir In oSubFolder.Subfolders
DirWalk oSubDir.path
Next
On Error GoTo 0
End Sub

Pozdrav
 
Odgovor na temu

[es] :: Access :: Brisanje fajlova po datumu modifikacije

[ Pregleda: 1551 | Odgovora: 1 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.