Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Filenames and formulae | Excel Worksheet Functions | |||
what do 'blue filenames' mean? | Excel Discussion (Misc queries) | |||
Using cell value in filenames | Excel Worksheet Functions | |||
Using Variables in filenames | Excel Discussion (Misc queries) | |||
Variable Filenames | Excel Programming |