Loop thru All Files in a Folder

[Juan Sanchez]

Hi All,

I've been here for this same threath a long time ago, I
just can't seem to remember how to do the following and
some how I've lost my macro.

I have a macro that calls each of the files in a path and
extracts some of the fields in it. The file opened is a
*.doc and the macro does some text to column stuff and so
forth so that I get the values from the report.

The reports name that my macro calls are 1.doc,
2.doc, ..., n.doc but this is not the name with which I
receive the reports, the name is given by the measuring
machine and is composed by part number, date, time etc...

After my post a long time ago, I was able to write a macro
that loops thru all the files in a given folder and
renames them into the usable 1.doc, 2.doc way and now i
don't have it.

Can anyone help me find the right code for this task???

I have 500+ files to rename, just to get 3 little numbers
from each...!!!

Help!
TIA

Juan

 

[Robin Hammond]

Juan,

this gives a full directory listing and should be easy to modify. It also
scans sub-folders.

You will need to use the name function to rename the files and remove the
bits that do the output to a worksheet.

Option Explicit

Sub FullDir()
ActiveWorkbook.Sheets.Add
GetFiles "c:\my documents\my excel files\xspandxl\", ".xls"
End Sub

Sub GetFiles(strRootDir As String, Optional strType As String)
Dim strDirName As String
Dim bTypeMatch As Boolean
Dim colDirs As Collection
Dim lDirCounter As Long
Dim lIndex As Long

Set colDirs = New Collection
colDirs.Add strRootDir
lDirCounter = 1
lIndex = 1

Do While lDirCounter <= colDirs.Count
strRootDir = colDirs(lDirCounter)
strDirName = Dir(strRootDir, vbDirectory + vbNormal)
Do While strDirName <> ""
If strDirName <> "." And strDirName <> ".." Then
If (GetAttr(strRootDir & strDirName) And vbDirectory) =
vbDirectory Then
'add to the directories collection so that this will be done
later
colDirs.Add strRootDir & strDirName & "\"
Else
'we found a normal file
bTypeMatch = False
If strType = "*.*" Then
bTypeMatch = True
ElseIf UCase(Right(strDirName, Len(strType))) =
UCase(strType) Then
bTypeMatch = True
End If
If bTypeMatch = True Then
'we found a valid file
Cells(lIndex, 1) = strRootDir & strDirName
lIndex = lIndex + 1
End If
End If
End If
strDirName = Dir
Loop
lDirCounter = lDirCounter + 1
Loop
End Sub

Robin Hammond
www.enhanceddatasystems.com

 

[Juan Sanchez]

Ok, after several attempts this seems to work:

'==========================
Option Explicit
Sub ReNameAll()
Dim FS As Object
Dim MyFolder As String
Dim MyName As String
Dim i As Integer
MyFolder = "C:\Documents and
Settings\Juan\Escritorio\Juan\"
Set FS = Application.FileSearch
With FS
..LookIn = MyFolder
..Filename = "*"
End With
If FS.Execute > 0 Then
For i = 1 To FS.FoundFiles.Count
MyName = FS.FoundFiles(i)
Name MyName As MyFolder & Format(i, "000") & ".doc"
Next i
Else
End If
End Sub
'==========================

Still, it doesn't looks like the last time and for sure
last time it was much more simpler... not that this one
is complicated... but at least it had less lines...

Any thoughts...any one....?

Cheers
Juan

 

[Juan Sanchez]

Robin, Thanks a lot, it worked fine, I had allready tryed
my solution, posted above, but yours is more versatile
with the subfolder option...

I then changed my code so that the .filesearch was coded
to subfolders = true and it worked fine...

Thanks for the code and the idea...Juan