-
In this method, I used DOS tricks. DOS requires the folder names with spaces to be enclosed in quotes so I added them in the two tests. This method is more reliable in some cases but can be 2-5 times slower.
I used a wait routine to make sure that DOS has time to create the text file. A ShellWait routine might be a better route that I will have to explore some time.
[vba]Sub Test1()
Dim a As Variant, s As String
s = """" & DesktopFolder & "\*.txt" & """"
a = FileList(s, True)
If UBound(a) = -1 Then Exit Sub
Range("A1").Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
End Sub
Sub Test2()
Dim a As Variant, s As String
s = """" & "c:\" & "DropDownList1.xls" & """"
a = FileList(s, True)
If UBound(a) = -1 Then
MsgBox "DropDownList1.xls not found."
Exit Sub
End If
Range("A1").Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
End Sub
Function DesktopFolder()
Dim wshShell As Object
Set wshShell = CreateObject("WScript.Shell")
DesktopFolder = wshShell.specialfolders("Desktop")
End Function
Function FileList(Folder As String, Optional subFolders As Boolean = False) As Variant
Dim sf As String, tFile As String
Dim diff As Long
Dim hFile As Integer, Str As String, vArray As Variant, e As Variant
Dim i As Integer, FolderPart As String
Dim iHandle As Integer
'Search subfolders if subFolders=True
sf = ""
If subFolders = True Then sf = "/s "
'Delete temp file if it exists and create path
tFile = Environ$("temp") & "\FileList.txt"
'If Dir$(tFile) <> "" Then Kill tFile
'Write a 0 byte file
iHandle = FreeFile
Open tFile For Output Access Write As #iHandle
Close #iHandle
'Put files into tFile
Shell Environ$("comspec") & " /c Dir /b " & sf & Folder & " > " & tFile, vbHide
'Wait until file writing is complete
Application.StatusBar = "Writing to " & tFile
diff = 1000
Do Until (diff = 0)
Application.Wait (Now + TimeValue("0:00:01"))
diff = diff - FileLen(tFile) 'Allow time for process to complete
Application.Wait (Now + TimeValue("0:00:01"))
If diff = 0 Then Exit Do
diff = FileLen(tFile)
Loop
Application.StatusBar = ""
'Show tFile in Notepad
'Shell "Notepad " & tFile
'Put tFile contents into an array
hFile = FreeFile
Open tFile For Binary Access Read As #hFile
Str = Input(LOF(hFile), hFile)
Close hFile
vArray = Split(Str, vbCrLf)
'Add base path to vArray elements if needed
FolderPart = Left(Folder, InStrRev(Folder, "\"))
For i = 0 To UBound(vArray)
If InStr(vArray(i), ":") <> 2 Then
vArray(i) = FolderPart & vArray(i)
End If
Next i
On Error Resume Next
ReDim Preserve vArray(0 To UBound(vArray) - 1)
FileList = vArray
End Function
Function FolderPart(sPath As String) As String
FolderPart = Left(sPath, InStrRev(sPath, "\"))
End Function
[/vba]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules