计算机代码清单目录,搜索文件夹并生成目录清单

贴上代码

Private Sub CommandButton1_Click()

's=search

On Error Resume Next

nums = 0

hlish = 3

Dim fsname As String

ActiveSheet.Range("E3:I200").Clear

Select Case Range("C4").Value '判断项目值OK====================================================

Case Is = "A"

hs2 = "h" '确定是项目列位置

Case Is = "B"

hs2 = "i"

Case Is = "C"

hs2 = "j"

Case Is = "D"

hs2 = "k"

Case Is = "E"

hs2 = "l"

Case Is = "F"

hs2 = "m"

Case Is = "G"

hs2 = "n"

Case Is = "H"

hs2 = "o"

Case Is = "I"

hs2 = "p"

Case Is = "J"

hs2 = "q"

End Select

Select Case Range("D4").Value '判断属性值OK=====================================================

Case Is = "数量"

hs = 6 '确定是项目数量

Case Is = "完成"

hs = 8 '确定是项目完成

Case Is = ""

MsgBox "请选择搜索内容：[数量]表示总量，[完成]表示已解决量！" '确定是空数据

End Select

'======================以上是本地数据调用项目和属性部分,文件夹判断在下面=====================================================

wbs = Dir(ThisWorkbook.Path & "\" & Range("B4").Value & "\" & "*.xls") '确定搜索分类目录==========================

Do While wbs > " "

If wbs <> ThisWorkbook.Name Then

Workbooks.Open ThisWorkbook.Path & "\" & Range("B4").Value & "\" & wbs

With Workbooks(2).Worksheets(1)

'建立目录,模块LIST开始，判断分离统计=====================================================

Select Case hs '判断属性值OK=====================================================

Case Is = 6

If .Range(hs2 & hs) > 0 Or Range(E4) = True Then

fsname = Workbooks(2).Name

End If

Case Is = 8

If .Range(hs2 & hs) > 0 Then

fsname = Workbooks(2).Name

End If

End Select

End With

Workbooks(2).Close

End If

wbs = Dir

nums = nums + 1 '对项目LIST编号进行累加1++

'===================================================合并单元格===========

Range("G" & hlish, "H" & hlish).MergeCells = True

'===================================================设置边框==========

Range("F" & hlish, "G" & hlish).Select

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

'============================================设置编号

Range("F" & hlish).Select

Range("F" & hlish).Value = nums

'===================================================生成文件目录?????????

Range("G" & hlish).Select

ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, _

Address:=ThisWorkbook.Path & "\" & Range("B4").Value & "\" & fsname, ScreenTip:="察看文件", TextToDisplay:=fsname

hlish = hlish + 1

'========================================================

Loop

End Sub