|
|
我把您这个程序用于编辑其他语文 英语 卫生目录，结果全给我出数学的目录
┣10卫生
┃ ┣第一章 集合
┃ ┃ ┣1.1 子集.doc
┃ ┃ ┣1.2 子集二.doc
┃ ┃ ┣1.3并集
┃ ┃ ┃ ┣1.3.1并集1.doc
┃ ┃ ┃ ┣1.3.2 并集2.doc
┃ ┣第二章 函数概念与基本初等函数
┃ ┃ ┣2.1函数的概念和图象.doc
┃ ┃ ┣2.4幂函数.doc
┃ ┃ ┣2.5函数与方程.xls
┃ ┃ ┣2.6函数模型及其应用.xls
┃ ┃ ┣2.3习题
┃ ┃ ┃ ┣2.3.1 习题一.doc
┃ ┃ ┃ ┣习题二.doc
┣10语文
┃ ┣第一章 集合
┃ ┃ ┣1.1 子集.doc
┃ ┃ ┣1.2 子集二.doc
┃ ┃ ┣1.3并集
┃ ┃ ┃ ┣1.3.1并集1.doc
┃ ┃ ┃ ┣1.3.2 并集2.doc
┃ ┣第二章 函数概念与基本初等函数
┃ ┃ ┣2.1函数的概念和图象.doc
┃ ┃ ┣2.4幂函数.doc
┃ ┃ ┣2.5函数与方程.xls
┃ ┃ ┣2.6函数模型及其应用.xls
┃ ┃ ┣2.3习题
┃ ┃ ┃ ┣2.3.1 习题一.doc
┃ ┃ ┃ ┣习题二.doc
而您以前做的二级文件夹什么的可以全部通用，语文的生成语文，英语的可以生成英语
程序为Sub Macro1()
Dim mypath$, mydir$, arr() As String, a, MyFilename$, i&, m&, n&, s1$, s2$
s1 = "┃ ┣"
s2 = "┃ ┃ ┣"
mypath = ThisWorkbook.Path & "\"
mydir = Dir(mypath & "*", vbDirectory)
While mydir > ""
If Not mydir Like ".*" And GetAttr(mypath & mydir) = vbDirectory Then
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = mypath & mydir
End If
mydir = Dir()
Wend
m = 1
Application.ScreenUpdating = False
With ActiveSheet
.[A1].CurrentRegion.Offset(1, 0).Clear
For i = 1 To n
m = m + 1
a = Split(arr(i), "\")
.Cells(m, 1) = s1 & a(UBound(a))
MyFilename = Dir(arr(i) & "\*.*")
Do While MyFilename <> ""
m = m + 1
.Hyperlinks.Add Anchor:=.Cells(m, 1), Address:=arr(i) & "\" & MyFilename, TextToDisplay:=s2 & Replace(MyFilename, "?", "")
MyFilename = Dir
Loop
Next
End With
Application.ScreenUpdating = True
End Sub
我是想是不是可以加个S3变量 ┃ ┃ ┃ ┣
或许就能通用，令您费神了 费心了 感谢您 |
|
楼主: linn339q
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-3-23 16:30
