Deleting Text Files using VB (1 Viewer)

[JohnLee]

Hi,

I've learnt how to delete folders and my process works fine, however I now have an additional task of having to delete text files that are contained within folders. However it's not just as simply as deleting anything with a ".txt" extension. I need to only delete those text files whose date is greater than 6 months. The date is contained within the text file name as follows:

aeg_130109.txt
beko_140209.txt
bosch_121208.txt

and so on.

These files reside in their own folders as follows:

aeg.fof
beko.fof
bosch.fof

and these folders reside in a top level folder called "BackupProdRegOnprdfs01\aeg.fof", which in turn sits on a network drive, so the full path for instance to the aeg.fof would be:

\\Leint03\ocrff_test\BackupProdRegOnprdfs01\aeg.fof

Leint03\ocrff_test is the server
BackupProdRegOnprdfs01 is the top level folder
aeg.fof is the folder in which the text files reside

So I need to have code that identifies the date part of the text file name and if it is greater than 6 months, then delete that text file and for this to automatically go to each ".fof" folder in turn and delete any text files that are older than 6 months. I have written the following code, but have got struck on how to get to the date part of the text file name.

================
BEGIN CODE
================

Dim FSO As FileSystemObject ' Declares the File System Object
Dim Folder As Folder 'Declares the Folder Object
Dim TextFilePathAEG 'Declares the TextFilePathAEG variable
Dim SubFolder As Folder
Dim File As File
Dim dtmDate As Date
Dim TextFileDate

'Set the text file paths here [the location where the text files are be stored]
TextFilePathAEG = "\\Leint03\ocrff_test\BackupProdRegOnprdfs01\aeg.fof"

Set FSO = New FileSystemObject
' If we can't read the images folder, stop running
If Not FSO.FolderExists(TextFilePathAEG) Then
MsgBox "Folder Doesn't Exist"
End
End If
For Each File In Folder.Files

' If file is a txt file then Delete it
If Right(File.Name, 4) = ".txt" Then




End If
Next

================
END CODE
================

Your assistance would be most appreciated.

John

 

[DCrake]

The first thing you need to do is to be able to parse the date out of the name of the file.

To do this you will need a function

Public Function GetDateFromFileName(strFileName As String) As Date

Dim StrDate As String

    StrDate = Left(Right(strFileName, 10), 6)
    
    StrDate = Left(StrDate, 2) & "/" & Mid(StrDate, 3, 2) & "/" & Right(StrDate, 2)

'Contend with invalid dates or filenames
If IsDate(CDate(StrDate)) = False Or IsNumeric(StrDate) = False Then
   GetDateFromFileName = Date()
   Exit Function
End If


    GetDateFromFileName = CDate(StrDate)

End Function

David

Then you need to compare the actual date to today's date and see if it needs deleting

Public Function FileOutOfDate(dtmFileDate As Date) As Boolean

If DateDiff("d",dtmFileDate,Date()) > (365/2) Then
   FileOutODate = True
Else
   FileOutOfDate = False
Endif

End Function

Finally...

If FileOutOfDate(GetDateFromFileName(strFileName)) = True Then
   Kill strFileName
End If

 

[JohnLee]

Hi DCrake,

Thanks for your response, I'll let you know how I get on.

John

 

[JohnLee]

Hi DCrake,

I've come up with the following code:

==============
BEGIN CODE
==============

Public Function DeleteTextFiles()

Dim FSO As FileSystemObject ' Declares the File System Object
Dim Folder As Folder 'Declares the Folder Object
Dim File As File 'Declares the File Object
Dim TextFilePath 'Declares the ImagePath variable
Dim SubFolder As Folder
Dim dtmDate As Date
Dim TextFileDate

'Set the image path here [the location where images are be stored]
TextFilePath = "\\Leint03\ocrff_Test\BackupProdRegOnprdfs01\"

Set FSO = New FileSystemObject
'If we can't read the images folder, stop running
If Not FSO.FolderExists(TextFilePath) Then
MsgBox "Folder Doesn't Exist"
End
End If
'Set the File System Object
Set FSO = New FileSystemObject
'Get the current date - 6 months
dtmDate = DateSerial(Year(Date), Month(Date) - 6, Day(Date))

'Loops through the subfolders looking for text files
For Each File In Folder.Files

'If file is a txt and it is 6 months or more old then delete it
If Right(File.Name, 4) = ".txt" Then
'Get the Text File Creation Date
TextFileDate = Mid(File.DateCreated, 7, 4) & Mid(File.DateCreated, 4, 2) & Mid(File.DateCreated, 1, 2) & "\"
'If the text file creation date is equal to or less than the
'current date - 6 months Then
If File.Name <= Format(dtmDate, "yyyymmdd") Then
'Delete the text file
File.Delete True
End If
End If
Next
End Function

==============
BEGIN CODE
==============

However when I run it, I get the following message and I don't know exactly what it's telling me:

"Run-time error 91"

"Object variable or With block variable not set"

It then highlights the follow code:

==========
BEGIN CODE
==========

For Each File In Folder.Files

=========
END CODE
=========

So there's clearly something I've done wrong, I have the in the references "Microsoft Scripting Runtime" checked, so the required references are enabled.

Your assistance would be appreciated.

John

 

[DCrake]

right so you are using tha actual file creation date instead of parsing it froom the actual fiel name.


As the TxtFileDate is already a date you can delcare it as a date.

Then all you need to do is to compare this date against today's date to see if it needs deleting.

Dim dtmFileDate As Date
dtmFileDate = File.DateCreated

If Int(DateDiff("d",Date(),dtmFileDate) > 365/2) Then
File.Delete = True
End If


David

 

[JohnLee]

Hi DCrake,

Thanks for your response, so are you saying that I don't need any of the code that I've written, just the code you supplied?

John

 

[DCrake]

Substitute

If Right(File.Name, 4) = ".txt" Then
'Get the Text File Creation Date
TextFileDate = Mid(File.DateCreated, 7, 4) & Mid(File.DateCreated, 4, 2) & Mid(File.DateCreated, 1, 2) & "\"
'If the text file creation date is equal to or less than the
'current date - 6 months Then
If File.Name <= Format(dtmDate, "yyyymmdd") Then
'Delete the text file
File.Delete True
End If

With

If Right(File.Name, 4) = ".txt" Then
   dtmFileDate = File.DateCreated
   If Int(DateDiff("d",Date(),dtmFileDate) > 365/2) Then
        File.Delete = True
   End If
End If

Don't forget to declare dtmFileDate at the top of your sub

 

[JohnLee]

Hi DCrake,

Thanks once again, I've made those changes, however I still get the run time error as follows:

"Run-time error 91"

"Object variable or With block variable not set"

It then highlights the follow code:

==========
BEGIN CODE
==========

For Each File In Folder.Files

=========
END CODE
=========

Any Ideas what might be causing this to trigger.

This is what my code now looks like:

==========
BEGIN CODE
==========

Public Function DeleteTextFiles()

Dim FSO As FileSystemObject ' Declares the File System Object
Dim Folder As Folder 'Declares the Folder Object
Dim File As File 'Declares the File Object
Dim TextFilePath 'Declares the ImagePath variable
Dim SubFolder As Folder
Dim dtmDate As Date 'Declare the dtmDate variable
Dim dtmFileDate As Date 'Declare the dtmFileDate variable

'Set the image path here [the location where images are be stored]
TextFilePath = "\\Leint03\ocrff_Test\BackupProdRegOnprdfs01\"

Set FSO = New FileSystemObject
'If we can't read the images folder, stop running
If Not FSO.FolderExists(TextFilePath) Then
MsgBox "Folder Doesn't Exist"
End
End If
'Set the File System Object
Set FSO = New FileSystemObject
'Get the current date - 6 months
dtmDate = DateSerial(Year(Date), Month(Date) - 6, Day(Date))

'Loops through the subfolders looking for text files
For Each File In Folder.Files
'If file is a txt file then
If Right(File.Name, 4) = ".txt" Then
'Get the date the file was created
dtmFileDate = File.DateCreated
'If the created date is equal to or more than 6 months old then
If Int(DateDiff("d", Date, dtmFileDate) > 365 / 2) Then
'Delete the text file
File.Delete True
End If
End If
Next
End Function

==========
END CODE
==========

John

 

[gemma-the-husky]

Pardon me for intruding

dates are tricky things

you have several dates

a) date created
b) date modified

these are obtained from the windows file system, using variations of the object you are using

c) embedded date

this is obtained by slicing the file name, in your case

----------
so you need to decide which is the most reliable for this purpose

----------
one other thought - deleting things in vba is a bit of a sledgehammer to crack a nut
you obviously need a lot of old files for archive purposes - surely its easier just to manually tidy these up now and again

however - to do this you will definitely find it easier if your files are sorted in date order, although this may not be possible

so not
bosch_121208.txt but

bosch_081212.txt ie bosch_YYMMDD

as YYMMDD automatically sorts in date order.

 

[JohnLee]

Hi Gemma,

Thanks for your response, we've been tidying up files manually for years and it takes an awful long time and can sometimes be forgotten about, which means it takes even longer when it's remembered. So automatically deleting files as each day goes by makes sense. We can generate up to 300 text files a day of varying size and with us moving to a new system that is going to be generating even more text files, we really need to go down this road.

So I think the solution that I have come to will work providing I can find out why I keep getting the error message identified in my earlier posts.

If you have any idea, that would be helpful.

John

 

[Mike375]

This might be of some use to you

http://allenbrowne.com/ser-59alt.html

It puts the full file name and path in a table from the selected folder. Once in an Access table then Left(), Right() or Mid(0 will get the date for your selection. You could then use Kill and do it dynamically from the file name in a continous form. You could put the Kill code in a module and then use a macro with a RunMacro to go through the records.

I have a little DB made using it and it is currently set up to remove the Read Only attribute from the files in a folder and copy them. I think you would only need to change

SetAttr ("" & Format([Forms]![Form2]![Together])), vbNormal

to Kill and change queries so as to grab your date for file selection.

If you think it would be of use I can zip and attach.

 

[JohnLee]

Hi,

Thanks for your response, I'm not sure that this would be the best method considering the large volume of text files involved. I'd prefer to delete them from where they are currently located. I would also prefer to keep the code to a minimum, having looked at the reference you provided, there is a large amount of code involved.

I've been able to develope code with the help of this forum to delete folders and it works, but another aspect of my project, just requires the deletion of text files, which I thought would be along the lines of folder deletion, but it is clear it's a different beast entirely.

Thanks once again, I will have to review my options.

John

 

[gemma-the-husky]

you can actually list/process files in a single folder easily using the dir function

[B]fname = dir(path)
while fname<>vbnullstring
  process fname
  fname = dir
wend[/B]

i actually just spent about an hour trying to write a recursive directory listing with the dir function. After this time, i eventually realised what the help meant when it said - you cant use dir recursively - ie dir doesnt retain its context in successive iterations, so after you drop down a level to a child folder, you cant continue where you left off at the parent level

shame - you could get round it by storing the files in the current folder in an array, but it loses all its elegance, and becomes more complex to do

but otherwise the recursive code should be something simple, like

[B]sub main
listfile(root)
end sub

sub listfile(rootpath as string)
'you would actually do this for each bit, by repeatedly calling dir as above
 for each file in rootpath
    addtofilelist
    if isdirectory then 
       listfile(rootpath & filename)
    end if
 next
end sub[/B]

 

[JohnLee]

Hi Gemma,

Thanks for your response. I've managed to resolve the Run-time error, but now my For...Each loop isn't working!!

I've placed a message box before, inside and after the For.....Each loop and the message boxes either side appear, but the message box inside the loop never appears.

This is what my code lookes like with the message boxes deployed:

=========
BEGIN CODE
=========

'Open the text file folders
Set Folder = FSO.GetFolder(TextFilePath)

MsgBox "Here Before the Loop"

'Loops through the folders looking for text files
For Each File In Folder.Files

MsgBox "Here Inside Loop"

'If file is a txt file then
If Right(File.Name, 4) = ".txt" Then
'Get the date the file was created
dtmFileDate = File.DateCreated
'If the created date is equal to or more than 6 months old then
If Int(DateDiff("d", Date, dtmFileDate) > 365 / 2) Then
'Delete the text file
File.Delete True
End If
End If
Next
MsgBox "Outside the Loop Here"

=========
END CODE
=========

Is there anything that you can see that might be wrong, I have a file whose creation date is greater than the 19th of Sep 08, so it should delete it, but it isn't!!

Your assistance would be appreciated.

John

 

[DCrake]

Here is an alternative search method you may want to try.

Sub FindScannedFiles4Input()
'Perform simple search using filesearch object
Dim varItem As Variant
Dim Folder As String
Dim objDB As Database
Dim I As Integer
Dim FolderLength As Integer
Dim fName As String
Set objDB = CurrentDb


Folder = CurrentProject.Path
StrListItems = "'"
With Application.FileSearch
    .NewSearch
    .FileName = "*.Txt"
    .LookIn = Folder
    .Execute
    
    For Each varItem In .FoundFiles
        FolderLength = Len(Folder) + 1
        fName = Mid(varItem, FolderLength)
     [B]   Debug.Print fName[/B]
        bFlag = True
    Next varItem

End With
objDB.Close
Set objDB = Nothing

End Sub

In this example I have cut out reduntant code for brevity You will need to put your code in the For Next loop


David

 

[JohnLee]

Hi Everybody,

Thanks very much for all your responses, it's been most helpful and enlightening. I have learnt so much. From your help I have come up with the following code which is tested and works great, this may be of assistance to others looking to do something along these lines:

============
BEGIN CODE
============

Public Function DeleteTextFiles()

Dim FSO As FileSystemObject ' Declares the File System Object
Dim Folder As Folder 'Declares the Folder Object
Dim SubFolder As Folder 'Declare the SubFolder Object
Dim File As File 'Declares the File Object
Dim TextFilePath 'Declares the TextFilePath variable
Dim dtmDate As Date 'Declare the dtmDate variable
Dim dtmFileDate As Date 'Declare the dtmFileDate variable
Dim TextFileDate 'Declare the TextFileDate variable

'Set the File System Object
Set FSO = CreateObject("Scripting.FileSystemObject")

'Assign the system date to the dtmDate variable
dtmDate = Date

'Set the image path here [the location where images are be stored]
TextFilePath = "\\Leint03\ocrff_Test\BackupProdRegOnprdfs01\"

'If we can't read the images folder, stop running
If Not FSO.FolderExists(TextFilePath) Then
MsgBox "Folder Doesn't Exist"
End
End If
'Open the text file folders
Set Folder = FSO.GetFolder(TextFilePath)

'Loops through the Folders looking for SubFolders
For Each SubFolder In Folder.SubFolders
'Loops through Subfolders looking for Files
For Each File In SubFolder.Files

'Get the current date - 6 months
dtmDate = DateSerial(Year(Date), Month(Date) - 6, Day(Date))

'If the file found has a ".txt" extension then
If Right(File.Name, 4) = ".txt" Then
'Get the date the file was created
dtmFileDate = Left(File.DateCreated, 10)
'If the created date is equal to or more than 6 months old then
If (DateDiff("d", Date, dtmFileDate) <= dtmDate) Then
'Delete the text file
File.Delete True
End If
End If
DoEvents
Next
Next
End Function

============
END CODE
============

Thanks again for all your advice and support.

John

 

[gemma-the-husky]

glad you got it working

it begs the question - how can you use these files, when there are so many

ie 300 per day gives about 36000 files in your folder (assuming you get weekends off) -

does anybody actually need these files, or use them for anything at all - or are they just there for archive reference if needed.

 

[JohnLee]

Hi Gemma,

I work for an insurance company that captures customer and client appliance registrations, we deal with over 140 different manufacturers, combined with their point of sale and individual general public registrations we get great deal of registration documents in all manner of papers and electronic formats, these are captured using a scanning system, which in turn produces text files for each manufacturer and their different insurance schemes.

The scanning system produces fixed width text files for uploading to our backend system, but as things do from time to time go wrong, we need to keep backup copies of text files so that we can recover quickly. Our experience has taught us that 6 months worth is sufficient, but of course that presents it's problems with regards to the management of them and doing it manually is no longer an option, particulary when we are moving to software that does not offer the same level of comfort as our existing software [I won't expand on this bit, it's highly emotive].

With changing business requirements and downsizing human resource, automatically managing this aspect makes sense.

And of course it's been fun learning about this aspect of programming in Access [even though there were times when I felt like giving up]. So all in all a good result.

John

 

[gemma-the-husky]

access really isnt the toy that IT departments would have you believe

and although doing stuff like you did needs direct programming, rather than just database tools, i actually find access and access vba a lot more intuitive and easy to use than VB

----------
one other thought, now you have explained the process in more detail - another way of doing this would be to load the new file names into a table in your access database, together with todays date - this would pick up any new files.

THEN you can simply identify the files to delete from your access table, rather than by interrogating the folder/file structure - as well as which you are storing a full record of all the files that were ever IN the folder.

--------
On another related point, can you answer this then

I have tried to understand what mechanism warehouse systems actually use to trace product serial numbers - I have come to the conclusion that they don't or can't. What I think they must do is know what serial numbers ranges are possible (although even this isnt strictly necessary), but they don't actually know where each appliance has ACTUALLY gone, until the owner registers it with the insurance co, etc. - so you can make sure an appliance is only registered once, and you can identify appliances that are never registered

Is that how they do it in practice?, or am I missing something?

 

[JohnLee]

Hi Gemma,

Interesting point with regards to Serial Numbers, Our experience is that customers don't always know what the appliance serial number is because of two things, the manufacturer has not clearly and concisely identified what the appliances serial number is or the serial number is acutally hidden inside the appliance somewhere that the customer has difficulty in finding it.

We as a company have identified this to manufacturers on many occasions, but it falls on deaf ears. So what happens in practice is the customer supplies us with what they think is the serial number, so we accept what they provide us with, because we have no way of knowing [unless a manufacturer supplies us with the format] what the serial number for that manufacturer looks like.

By the same token a manufacuturer group can use different serial number formats for the same type of appliance being produce within their group for instance Indesit, Hotpoint, Creda, Cannon and Ariston are all part of the same manufacturer group, but have different branding and therefore whilst they may all produce the same type of appliances, their serial numbering may not follow the same format.

Because manufacuturer's do not supply us with a list of serial numbers and customers don't always when registering their products supply the correct or even provide their products serial number, ensuring that an appliance is on registered once is near impossible.

What do have is a system that knows how many products that are registered to a customer if they have registered a product with us.

So to answer your question "can we identify an appliance that has never been registered" the answer is a resounding No, because the manufacturers don't supply us the serial number lists.

An appliance can be out there somewhere in a shop waiting to be sold for years before it is registered. only last year we had an appliance registered as new, which was in actual fact over 15 years old! It happens.

I hope that has given you a little more food for thought.

John