|
直接用VB6写的
- Public Sub findname()
- Dim fs, f, f1, fc, s
- Set fs = CreateObject("Scripting.FileSystemObject")
- Set f = fs.GetFolder(Text1.Text) '在括号内输入你指定的目录
- Set fc = f.Files
- Set br = f.subfolders
- ReDim arr(1 To 1000, 1 To 1)
- For Each wjj In br
- n = n + 1
- arr(n, 1) = wjj.Path
- If Len(Split(wjj.Path, "")(UBound(Split(wjj.Path, "")))) = 8 And Left(Split(wjj.Path, "")(UBound(Split(wjj.Path, ""))), 2) = "20" Then
- Name Text1.Text & "" & Split(wjj.Path, "")(UBound(Split(wjj.Path, ""))) As Text1.Text & "" & Format(Split(wjj.Path, "")(UBound(Split(wjj.Path, ""))), "0000-00-00")
- End If
- Next
- MsgBox "已完成"
- End Sub
- Private Sub Command1_Click()
- findname
- End Sub
复制代码
|
|