windows xp file name convertion question

[Sceptor]

I have windows xp and office xp professonal. I have several folders
with many many files in them. Is there anyway I can import the file
names, not the files themselves into excel.

[Ron de Bruin]

You can use code like this
Here is a macro example from Dave Peterson

Try it in a new workbook
Change the folder
myPath = "c:\data"

Sub testme()
Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

'change to point at the folder to check
myPath = "c:\data"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
For fCtr = LBound(myFiles) To UBound(myFiles)
Cells(fCtr, 1).Value = myFiles(fCtr)
Next fCtr
End If
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Sceptor" <[email protected]> wrote in message news:[email protected]...
>I have windows xp and office xp professonal. I have several folders
> with many many files in them. Is there anyway I can import the file
> names, not the files themselves into excel.

[Gord Dibben]

Several methods to accomplish this.......I like Tushar's best.

To add a "Print Directory" feature to Explorer, go to
this KB Article.

http://support.microsoft.com/default...EN-US;q272623&

Or you can download Printfolder 1.2 from.....

http://no-nonsense-software.com/freeware/

I use PF 1.2 and find it to be more than adequate with custom features.

OR Go to DOS(Command) prompt and directory.
Type DIR >MYFILES.TXT

All the above create a *.TXT file which can be opened in Excel.

One more method if you want to by-pass the *.TXT file and pull directly to
Excel is to use Tushar Mehta's Excel Add-in. This allows filtering and
sorting once you have the data in Excel.

http://www.tushar-mehta.com/ scroll down to Add-ins>Directory Listing.

Download the ZIP file and un-zip to your Office\Library folder.


Gord Dibben Excel MVP

On Thu, 24 Mar 2005 21:07:25 GMT, Sceptor <[email protected]> wrote:

>I have windows xp and office xp professonal. I have several folders
>with many many files in them. Is there anyway I can import the file
>names, not the files themselves into excel.

[Bob Phillips]

Option Explicit

Dim FSO As Object
Dim cnt As Long
Dim arfiles
Dim level As Long

Sub Folders()
Dim i As Long
Dim sFolder As String
Dim iStart As Long
Dim iEnd As Long
Dim fOutline As Boolean

Set FSO = CreateObject("Scripting.FileSystemObject")

arfiles = Array()
cnt = -1
level = 1

sFolder = "E:\"
ReDim arfiles(2, 0)
If sFolder <> "" Then
SelectFiles sFolder
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Files").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Worksheets.Add.Name = "Files"
With ActiveSheet
For i = LBound(arfiles, 2) To UBound(arfiles, 2)
If arfiles(0, i) = "" Then
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If
With .Cells(i + 1, arfiles(2, i))
.Value = arfiles(1, i)
.Font.Bold = True
End With
iStart = i + 1
iEnd = iStart
fOutline = False
Else
.Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
Address:=arfiles(0, i), _
TextToDisplay:=arfiles(1, i)
iEnd = iEnd + 1
fOutline = True
End If
Next
.Columns("A:Z").ColumnWidth = 5
End With
End If
'just in case there is another set to group
If fOutline Then
Rows(iStart + 1 & ":" & iEnd).Rows.Group
End If

Columns("A:Z").ColumnWidth = 5
ActiveSheet.Outline.ShowLevels RowLevels:=1
ActiveWindow.DisplayGridlines = False

End Sub

'-----------------------------------------------------------------------
Sub SelectFiles(Optional sPath As String)
'-----------------------------------------------------------------------
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath

If sPath = "" Then
Set FSO = CreateObject("SCripting.FileSystemObject")
sPath = "c:\myTest"
End If

arPath = Split(sPath, "\")
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = ""
arfiles(1, cnt) = arPath(level - 1)
arfiles(2, cnt) = level

Set oFolder = FSO.GetFolder(sPath)
Set oFiles = oFolder.Files
For Each oFile In oFiles
cnt = cnt + 1
ReDim Preserve arfiles(2, cnt)
arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
arfiles(1, cnt) = oFile.Name
arfiles(2, cnt) = level + 1
Next oFile

level = level + 1
For Each oSubFolder In oFolder.Subfolders
SelectFiles oSubFolder.Path
Next
level = level - 1

End Sub

#If VBA6 Then
#Else
'-----------------------------------------------------------------
Function Split(sText As String, _
Optional sDelim As String = " ") As Variant
'-----------------------------------------------------------------
Dim i%, sFml$, v0, v1
Const sDQ$ = """"

If sDelim = vbNullChar Then
sDelim = Chr(7)
sText = Replace(sText, vbNullChar, sDelim)
End If
sFml = "{""" & Application.Substitute(sText, sDelim, """,""") & """}"
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next

Split = v0

End Function

'---------------------------------------------------------------------------
-----
Public Function InStrRev(stringcheck As String, _
ByVal stringmatch As String, _
Optional ByVal start As Long = -1)
'---------------------------------------------------------------------------
-----
Dim iStart As Long
Dim iLen As Long
Dim i As Long

If iStart = -1 Then
iStart = Len(stringcheck)
Else
iStart = start
End If

iLen = Len(stringmatch)

For i = iStart To 1 Step -1
If Mid(stringcheck, i, iLen) = stringmatch Then
InStrRev = i
Exit Function
End If
Next i
InStrRev = 0
End Function
'-----------------------------------------------------------------
#End If


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Sceptor" <[email protected]> wrote in message
news:[email protected]...
> I have windows xp and office xp professonal. I have several folders
> with many many files in them. Is there anyway I can import the file
> names, not the files themselves into excel.

[Sceptor]

Thank You all for the help.

Sceptor



On Thu, 24 Mar 2005 22:14:30 -0000, "Bob Phillips"
<[email protected]> wrote:

>Option Explicit
>
>Dim FSO As Object
>Dim cnt As Long
>Dim arfiles
>Dim level As Long
>
>Sub Folders()
>Dim i As Long
>Dim sFolder As String
>Dim iStart As Long
>Dim iEnd As Long
>Dim fOutline As Boolean
>
> Set FSO = CreateObject("Scripting.FileSystemObject")
>
> arfiles = Array()
> cnt = -1
> level = 1
>
> sFolder = "E:\"
> ReDim arfiles(2, 0)
> If sFolder <> "" Then
> SelectFiles sFolder
> Application.DisplayAlerts = False
> On Error Resume Next
> Worksheets("Files").Delete
> On Error GoTo 0
> Application.DisplayAlerts = True
> Worksheets.Add.Name = "Files"
> With ActiveSheet
> For i = LBound(arfiles, 2) To UBound(arfiles, 2)
> If arfiles(0, i) = "" Then
> If fOutline Then
> Rows(iStart + 1 & ":" & iEnd).Rows.Group
> End If
> With .Cells(i + 1, arfiles(2, i))
> .Value = arfiles(1, i)
> .Font.Bold = True
> End With
> iStart = i + 1
> iEnd = iStart
> fOutline = False
> Else
> .Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
> Address:=arfiles(0, i), _
> TextToDisplay:=arfiles(1, i)
> iEnd = iEnd + 1
> fOutline = True
> End If
> Next
> .Columns("A:Z").ColumnWidth = 5
> End With
> End If
> 'just in case there is another set to group
> If fOutline Then
> Rows(iStart + 1 & ":" & iEnd).Rows.Group
> End If
>
> Columns("A:Z").ColumnWidth = 5
> ActiveSheet.Outline.ShowLevels RowLevels:=1
> ActiveWindow.DisplayGridlines = False
>
>End Sub
>
>'-----------------------------------------------------------------------
>Sub SelectFiles(Optional sPath As String)
>'-----------------------------------------------------------------------
>Dim oSubFolder As Object
>Dim oFolder As Object
>Dim oFile As Object
>Dim oFiles As Object
>Dim arPath
>
> If sPath = "" Then
> Set FSO = CreateObject("SCripting.FileSystemObject")
> sPath = "c:\myTest"
> End If
>
> arPath = Split(sPath, "\")
> cnt = cnt + 1
> ReDim Preserve arfiles(2, cnt)
> arfiles(0, cnt) = ""
> arfiles(1, cnt) = arPath(level - 1)
> arfiles(2, cnt) = level
>
> Set oFolder = FSO.GetFolder(sPath)
> Set oFiles = oFolder.Files
> For Each oFile In oFiles
> cnt = cnt + 1
> ReDim Preserve arfiles(2, cnt)
> arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
> arfiles(1, cnt) = oFile.Name
> arfiles(2, cnt) = level + 1
> Next oFile
>
> level = level + 1
> For Each oSubFolder In oFolder.Subfolders
> SelectFiles oSubFolder.Path
> Next
> level = level - 1
>
>End Sub
>
>#If VBA6 Then
>#Else
>'-----------------------------------------------------------------
>Function Split(sText As String, _
> Optional sDelim As String = " ") As Variant
>'-----------------------------------------------------------------
> Dim i%, sFml$, v0, v1
> Const sDQ$ = """"
>
> If sDelim = vbNullChar Then
> sDelim = Chr(7)
> sText = Replace(sText, vbNullChar, sDelim)
> End If
> sFml = "{""" & Application.Substitute(sText, sDelim, """,""") & """}"
> v1 = Evaluate(sFml)
> 'Return 0 based for compatibility
> ReDim v0(0 To UBound(v1) - 1)
> For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next
>
> Split = v0
>
>End Function
>
>'---------------------------------------------------------------------------
>-----
>Public Function InStrRev(stringcheck As String, _
> ByVal stringmatch As String, _
> Optional ByVal start As Long = -1)
>'---------------------------------------------------------------------------
>-----
>Dim iStart As Long
>Dim iLen As Long
>Dim i As Long
>
> If iStart = -1 Then
> iStart = Len(stringcheck)
> Else
> iStart = start
> End If
>
> iLen = Len(stringmatch)
>
> For i = iStart To 1 Step -1
> If Mid(stringcheck, i, iLen) = stringmatch Then
> InStrRev = i
> Exit Function
> End If
> Next i
> InStrRev = 0
>End Function
>'-----------------------------------------------------------------
>#End If