Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 358
Default Getting filenames via VBA

Hi,

Is there an easy way to get the filenames (in a text file) if I quote the
path. For example if I know the path is C:\Andrew can I get a flat file with:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt

Can we take it one step further and get all files on a drive if I don't know
the path but I do know the drive (C:\). Then you may get:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt
C:\Smith\file_a.txt
C:\Smith\file_b.txt

Thanks in advance.



--
Andrew
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 983
Default Getting filenames via VBA

You want to look up file system objects. I dont' have any code handy, but the
help files on the mircrosoft website are pretty good for this. The FSO object
is part of the Microsoft Scripting Runtime reference...

HTH

"Andrew" wrote:

Hi,

Is there an easy way to get the filenames (in a text file) if I quote the
path. For example if I know the path is C:\Andrew can I get a flat file with:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt

Can we take it one step further and get all files on a drive if I don't know
the path but I do know the drive (C:\). Then you may get:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt
C:\Smith\file_a.txt
C:\Smith\file_b.txt

Thanks in advance.



--
Andrew

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Getting filenames via VBA

Here's some code that lists all the files. You should be able to adapt to
output to a text file

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)


"Andrew" wrote in message
...
Hi,

Is there an easy way to get the filenames (in a text file) if I quote the
path. For example if I know the path is C:\Andrew can I get a flat file

with:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt

Can we take it one step further and get all files on a drive if I don't

know
the path but I do know the drive (C:\). Then you may get:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt
C:\Smith\file_a.txt
C:\Smith\file_b.txt

Thanks in advance.



--
Andrew



  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,253
Default Getting filenames via VBA

Bob,

i think there's a small error in procedure Select Files.

if sPath < "" what happens to FSO?

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

following makes more sense:

if fso is nothing then
Set FSO = CreateObject("SCripting.FileSystemObject")
end if
if spath = "" then
spath = curdir
end if

further..
it might make sense to make fso a static procedure level variable.
as it's solely used inside the SelectFiles proc.

more..
I'd make this early bound: since's it's a recursive routine that might
make an awful lot of loops, I'm fairly certain the speed benifits would
be 'measurable', certainly when let loose on a large drive on a "low
level" path.


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Bob Phillips wrote :

Here's some code that lists all the files. You should be able to
adapt to output to a text file

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

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Getting filenames via VBA

Thanks for those useful comments, I will take on board and update.

This is a standard procedure that I have in the code library, and when used
it invariably gets changed, and I would hope (!) that the special conditions
do get more robustly handled in the production code <g.

Your point about early binding is especially well made. I tend to use this
code for small directories, but there is no reason it can't be used on large
drive. I also tend to give most responses in the NG with late bound as
explaining how to set references seems to cause problems, and we all know
the problems less experienced guys get into with version compatibility, but
it is probably time to be a bit more inclusive.

Regards

Bob


"keepITcool" wrote in message
ft.com...
Bob,

i think there's a small error in procedure Select Files.

if sPath < "" what happens to FSO?

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

following makes more sense:

if fso is nothing then
Set FSO = CreateObject("SCripting.FileSystemObject")
end if
if spath = "" then
spath = curdir
end if

further..
it might make sense to make fso a static procedure level variable.
as it's solely used inside the SelectFiles proc.

more..
I'd make this early bound: since's it's a recursive routine that might
make an awful lot of loops, I'm fairly certain the speed benifits would
be 'measurable', certainly when let loose on a large drive on a "low
level" path.


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Bob Phillips wrote :

Here's some code that lists all the files. You should be able to
adapt to output to a text file

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





  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 400
Default Getting filenames via VBA

Here's a one-line solution:

shell "cmd /C dir c:\*.txt c:\aa.txt /b /s"


"Andrew" wrote:

Hi,

Is there an easy way to get the filenames (in a text file) if I quote the
path. For example if I know the path is C:\Andrew can I get a flat file with:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt

Can we take it one step further and get all files on a drive if I don't know
the path but I do know the drive (C:\). Then you may get:

C:\Andrew\file_a.txt
C:\Andrew\file_b.txt
C:\Smith\file_a.txt
C:\Smith\file_b.txt

Thanks in advance.



--
Andrew

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Filenames and formulae SimoninParis Excel Worksheet Functions 4 September 25th 09 04:21 PM
what do 'blue filenames' mean? Boswell Excel Discussion (Misc queries) 2 January 16th 07 05:36 PM
Using cell value in filenames Neil Beddell Excel Worksheet Functions 3 July 19th 06 08:22 PM
Using Variables in filenames Blinky Bill Excel Discussion (Misc queries) 2 March 11th 05 12:07 AM
Variable Filenames Paul Kendall Excel Programming 2 October 13th 03 03:30 PM


All times are GMT +1. The time now is 06:42 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"