I want to print a LIST of documents in a folder without having to print the
actual documents. I need to do this to compare documents in two seperate
folders for duplication.
I want to print a LIST of documents in a folder without having to print the
actual documents. I need to do this to compare documents in two seperate
folders for duplication.
Option Explicit
Private cnt As Long
Private arfiles
Private 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
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)
'-----------------------------------------------------------------------
Static FSO As Object
Dim oSubFolder As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim arPath
If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If
If sPath = "" Then
sPath = CurDir
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(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------**-----------------------------*-*------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues
If Delimiter = vbNullChar Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If
sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") &
"""}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next
Split = aryValues
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
Bob Phillips
(replace somewhere in email address with gmail if mailing direct)
"littlebear20" <littlebear20@discussions.microsoft.com> wrote in message
news:6AC44DB0-8FB4-43E9-9907-BEA2772387E2@microsoft.com...
> I want to print a LIST of documents in a folder without having to print
the
> actual documents. I need to do this to compare documents in two seperate
> folders for duplication.
Several methods to accomplish this.......I like Tushar's best if importing to
Excel.
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 Notepad or
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 MS Excel MVP
On Wed, 16 Aug 2006 08:22:02 -0700, littlebear20
<littlebear20@discussions.microsoft.com> wrote:
>I want to print a LIST of documents in a folder without having to print the
>actual documents. I need to do this to compare documents in two seperate
>folders for duplication.
Gord Dibben MS Excel MVP
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks