Sorting *.txt files to newly created folders? (based on its contents)

[J. Verdaasdonk]

Hi Everybody,

Difficult question this time: (Hmmm for me so to speak)

I have a lot of *.txt files that are generated from a database.
In these files there is a Unique number normally these codes are 8
digits and sometimes 10! (Example: 12345678) All unique numbers are in
the top section of the files.

I would like to order all these files in to subfolders depending on the
first 4 numbers off the code! So 12345678 would go in to folder 1234
and 23456789 would go in to folder 2345.

All files are stored in: C:\My Documents\T-files

What I think I need is some code that will open this folder and reads
the contents of a *txt file. When it finds a Number it reads the first
four digits. These four digits represent the folder name in witch to
store this file.
With this number string a new folder is created and the *txt file of
witch it originated is transferred to this folder. Then the code will
go to the next *.txt files until there aren’t any left.

I don’t know if al of this is possible so I’ve tried to search for
alternative solution.

In stead of reading the content of the *.txt file maybe it’s possible
to open the txt file in to a new word document. Then find the Unique
number (8 to 10 digits) and then save this file in the folder that is
created from the first four numbers with perhaps the document name that
is the full 8 to 10 digits number?

I’m just brainstorming on a solution to get these *.txt files organized
in to a more friendly folder set up!

Anybody got Ideas?

Thnxxxx!

 

[Doug Robbins - Word MVP]

Definitely possible.

You would use a batch processing macro to open each file in turn, use a
wildcard Find to locate the 8 or 10 digit number using [0-9]{8,} the use
ChDir to check for the existence of a folder with the name of the first 4
digits, and if that throws an error, use MkDir to create it, then save the
file to that folder with the file name being the 8 or 10 digit number.

--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[Perry]

What I think I need is some code that will open this folder and reads

the contents of a *txt file. When it finds a Number it reads the first
four digits. These four digits represent the folder name in witch to
store this file.

Here's a macro and a supporting function that does what you want.
You may want to adjust the code to meet yr requirements
but it basically covers the above wish.

Krgrds,
Perry

== begin VBA code
'******************
Sub MoveTextFiles()
'folder in which textfiles are residing
Const sTextFolder As String = "C:\Temp"

Dim sNameFolder As String
Dim sNameFile As String
Dim sOrgFile As String

With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
.FileName = "*.txt"
.LookIn = sTextFolder
.Execute _
msoSortByFileName, msoSortOrderAscending, True

For x = 1 To .FoundFiles.Count

sOrgFile = .FoundFiles(x)
'retrieve filename
sNameFile = Right$(sOrgFile, _
Len(sOrgFile) - InStrRev(sOrgFile, "\"))

'retrieve foldername
sNameFolder = Left$(sNameFile, 4)

'check whether subfolder exists
If Len(Dir(sTextFolder & "\" & sNameFolder, _
vbDirectory)) = 0 Then
'create new folder
MkDir sTextFolder & "\" & sNameFolder
End If

'recompose new filename (new folder)
sNameFile = _
sTextFolder & "\" & sNameFolder & "\" & sNameFile

On Local Error GoTo ErrMove
If Not IsFileOpen(sOrgFile) Then

'move the file to newly created folder
Name sOrgFile As sNameFile

Else
'>> you might want to log failure of
'>> moving the file in this code section

End If

Next
End With

Exit Sub
ErrMove:
'>> you might want to log failure of
'>> moving the file in this code section as well
Resume Next
End Sub

'*******************************************************
Function IsFileOpen(ByVal FileName As String) As Boolean
'Function to test whether a document is in use/opened
'-------------------
Dim iFile As Integer
iFile = FreeFile
On Local Error GoTo ErrOpen
Open FileName For Binary Access Read Lock Read As #iFile
'do nothing
Close #iFile
ExitHere:
Exit Function
ErrOpen:
IsFileOpen = True
Resume ExitHere
End Function
== end VBA code

 

[Helmut Weber]

Hi J.,
as far as I understand this, I can't see, that Perry searches
the contents of the file for the 8 or 10 digit number.
So here is my mostly untested solution, as where would I get the
appropriate files from?
Notice, that I have put a "-" in the name of the source folder.
and, that the list delimiter "," in the wildcard search {8,}
could be an ";" depending on localization,
and that I am assuming, the text files are rather small.
The idea of opening the files not in Word itself comes from the
necessity to avoid questions on text to word conversions, and from the
idea, not to touch the content in any way, and from the fear of
unexpectedly changing default font to gothic etc., when inserting
a text file into a word-doc. Should the textfiles be rather large,
a different approach may be necessary, e.g. reading the complete
textfile into one string, and AFAIK, the command "on error goto -1",
that should clear any error, is not documented.

Sub Movem()
Const Source As String = "c:\My-Documents\T-Files\"
Const Target As String = "c:\Target\"
Dim aLineofText As String ' a line from a txt-file
Dim newDirName As String ' a folder
Dim newPthName As String ' a path
Dim newFilName As String ' a file

Dim oldFileName() As String ' array of old filenames

Dim l As Long ' a counter
Dim countfiles As Long ' number of files

Dim r As Range
Set r = ActiveDocument.Range

With Application.FileSearch
.NewSearch
.LookIn = Source
.FileName = "*.txt"
.Execute
countfiles = .FoundFiles.Count
ReDim oldFileName(countfiles)
For l = 1 To countfiles
oldFileName(l) = .FoundFiles(l)
Next
End With

For l = 1 To countfiles
Set r = ActiveDocument.Range
r.Delete
Open oldFileName(l) For Input As #1
While Not EOF(1)
Input #1, aLineofText
r.InsertAfter aLineofText
Wend
Close #1
With r.Find
.Text = "[0-9]{8,}" ' beware of localization
.MatchWildcards = True
.Execute
' build new names for target
newDirName = Left(r.Text, 4)
newPthName = Target & newDirName
newFilName = r.Text & ".txt"
On Error Resume Next
MkDir newPthName
On Error GoTo -1 ' clear error
newFilName = newPthName & "\" & newFilName
Name oldFileName(l) As newFilName
End With
Next
End Sub

Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98

 

[J. Verdaasdonk]

Hi Doug & Perry & Helmut,

First of al I’m stunned by the help I’m receiving today! (thank you s
much!)

Doug,
thnx for setting up the way to follow on writing the code snippet!

Perry,
I’ve tried out you’re code while knowing it doesn’t look for th
specific numbers in the *txt files. But I thought maybe it would be
great sorting macro for files in general!

You’re code runs brilliant on the file name off the *txt file so
presume you must have misread my question! But anyway thank you fo
this brilliant code to sort out the files by file name to there ow
subfolder!
In you’re code you are referring to: “'>> you might want to log failur
of
'>> moving the file in this code section”
Could you please tell me what kind off code you had in mind? (sound
useful to now if what if any files caused an error)

Hellmut,
You’re code does exactly what I want!
Thank you so much for providing it.

Especially the story about the delimiter (,) to ( ; ) in the Wildcar
search was extremely helpful! (I needed ( ; ) )
Could you please explain what’s so important about this delimiter an
is it set in the configuration panel? (something to do with differen
countries)

O Yeh, Helmut what does “and AFAIK” mean?

Greetings from Holland!
Ps, the only thing that's a problem with both off the code snippets i
that they take a long time to get processed! (

 

[J. Verdaasdonk]

Hi Guys,

Would you be so kind to help me out one more time?

I'm using the code of Helmut that runs great!

But some of the users are complaining about the renaming of the *tx
files. They would rather have the original names back. (they make mor
sens to them)Wish I've would have know that before......

I've been trying to change you're code Helmut but I can't seem to mak
it work.

In the middle of the code you ReDim the String oldFileName wit
(countfiles) I think I've got to find the answer in that area?

Could you please help me change the code so that the old file names ar
retained?

See Yah! ;

 

[A. Chja]

Hi J.

Especially the story about the delimiter (,) to ( ; ) in the Wildcard
search was extremely helpful! (I needed ( ; ) )
Could you please explain what?s so important about this delimiter and

it is better called "listseperator". You get it by
MsgBox Application.International(wdListSeparator)
It is important, because the wildcardsearch and maybe some other things
don't work with the wrong seperator.

O Yeh, Helmut what does ?and AFAIK? mean?

As far as I know
see: http://www.cse.ucsc.edu/~shankari/abbreviations.html

Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr(64) & "t-online.de"
Word XP, Windows 2000

 

[A. Chja]

Hi J.,
I can't test it, where I am right now.
But it is "newfilname", that has to be changed,
as there is no new filename ;-)
Dim s as String ' a new var just for brevity
s = oldfilename(l) ' the fullname from the array
newfilname = Right(s, Len(s) - InStrRev(s, "\"))
and later
newFilName = newPthName & "\" & newFilName
Note, that the command "name" does not work
across different devices.
HTH, hope this helps

Greetings from Bavaria, Germany
Helmut Weber
"red.sys" & chr(64) & "t-online.de"
Word XP, Windows 2000

 

[J. Verdaasdonk]

BUMP :

 

[J. Verdaasdonk]

Hi Helmut,

Thnxx for the Explanation!
Things have worked out fine many greetings to Bavaria!

O Yeh that's a funny site of chatroom slang