|
|
楼主，请查看附件，所有的代码都在附件。测试一下，看看是否满足你的要求。
主要是使用DIR函数+递归，但是DIR函数没有排序的功能，所以程序还对文件和文件夹进行排序，并将WORD文档和EXCEL 文档分开显示。
第一层文件夹，本程序只支持对类似（第1章，第2章，，，）的排序，不支持对类似（第一章，第二章，，，，），所以楼主如果
采用这个程序，要将文件夹中的一、二、三、、、等改为阿拉伯数字。
以下是主要的递归部分：- Sub Recsive(ByVal currentPath As String, ByVal Censhu As Integer)
- '存储currentPath 目录下的文件夹数组
- Dim DirShuzu() As String
- '存储currentPath 目录下的.DOC 文件数组
- Dim DocShuzu() As String
- '存储currentPath 目录下的.XLS 文件数组
- Dim XlsShuzu() As String
- '搜索字串
- Dim MyName$, temp$, i&, j&, k&, xh1&, xh2&
- i = 0
- j = 0
- k = 0
- MyName = Dir(currentPath, vbNormal + vbDirectory)
-
- Do While MyName <> ""
- If MyName <> "." And MyName <> ".." Then
- '搜索currentPath 目录下的所有文件夹
- If (GetAttr(currentPath & MyName) And vbDirectory) = vbDirectory Then
- ReDim Preserve DirShuzu(i)
- DirShuzu(i) = currentPath + MyName + ""
- i = i + 1
- '搜索currentPath 目录的所有word 文档
- ElseIf MyName Like "*.doc" Or MyName Like "*.docx" Then
- ReDim Preserve DocShuzu(j)
- DocShuzu(j) = currentPath + MyName
- j = j + 1
- '搜索currentPath 目录下的所有Excel 文档
- ElseIf MyName Like "*.xls" Or MyName Like "*.xlsx" Then
- ReDim Preserve XlsShuzu(k)
- XlsShuzu(k) = currentPath + MyName
- k = k + 1
- End If
- End If
- MyName = Dir
- Loop
- If j > 1 Then
- ShuzuSort DocShuzu, Censhu, currentPath
- End If
- '将Word 文档显示在Excel 中
- For xh1 = 0 To j - 1
- temp = "┣"
- For xh2 = 1 To Censhu
- temp = "| " + temp
- Next
- temp = temp + Mid(DocShuzu(xh1), Len(currentPath) + 1, Len(DocShuzu(xh1)))
- ActiveSheet.Hyperlinks.Add Anchor:=Range("A65536").End(xlUp).Offset(1, 0), Address:=DocShuzu(xh1), TextToDisplay:=temp
- Range("A65536").End(xlUp).Font.ColorIndex = 49
- Next
- If k > 1 Then
- ShuzuSort XlsShuzu, Censhu, currentPath
- End If
- '将Excel 文档现在是工作表中
- For xh1 = 0 To k - 1
- temp = "┣"
- For xh2 = 1 To Censhu
- temp = "| " + temp
- Next
- temp = temp + Mid(XlsShuzu(xh1), Len(currentPath) + 1, Len(XlsShuzu(xh1)))
- ActiveSheet.Hyperlinks.Add Anchor:=Range("A65536").End(xlUp).Offset(1, 0), Address:=XlsShuzu(xh1), TextToDisplay:=temp
- Range("A65536").End(xlUp).Font.ColorIndex = 49
- Next
- If i > 1 Then
- ShuzuSort DirShuzu, Censhu, currentPath
- End If
- '递归搜索currentPath目录下的文件夹，所包含的文件夹和文件
- For xh1 = 0 To i - 1
- '先显示在进入递归
- temp = "┣"
- For xh2 = 1 To Censhu
- temp = "| " + temp
- Next
- temp = temp + Mid(DirShuzu(xh1), Len(currentPath) + 1, Len(DirShuzu(xh1)))
- temp = Mid(temp, 1, Len(temp) - 1)
- Range("A65536").End(xlUp).Offset(1, 0).Value = temp
- Range("A65536").End(xlUp).Font.ColorIndex = 1
- '进入递归
- Recsive DirShuzu(xh1), (Censhu + 1)
- Next
- End Sub
[ 本帖最后由 clarkldq 于 2010-3-25 15:10 编辑 ] |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-3-22 16:49
楼主
