vb 做一个窗口 只要按下按钮 就可以获取指定文件夹内的所有文件的文件名,然后将其写入TXT文件内!
如果文件夹内还有文件夹同样获取里面的文件的文件名,但在写入txt时在文件名前面加 <文件所在的文件夹的名称>
比如指定的文件夹为 :d盘下的123文件 在123里有五个文件和两个文件夹。五个文件分别为:1.txt, 2.gif, 该死的温柔.mp3,a.rm,
QQ.exe 两个文件夹名称分别为:临时,常用。 里面的文件与上一级文件夹的文件相同。按下按钮后
会在txt文件里写入这样格式的内容:
<123>1.txt
<123>2.gif
<123>该死的温柔.mp3
<123>a.rm
<123>QQ.exe
<123><临时>1.txt
<123><临时>2.gif
<123><临时>该死的温柔.mp3
<123><临时>a.rm
<123><临时>QQ.exe
<123><常用>1.txt
<123><常用>2.gif
<123><常用>该死的温柔.mp3
<123><常用>a.rm
<123><常用>QQ.exe
高手帮忙写下完整代码!
会有好多分的哦
!
VBå¯ä»¥ä½¿ç¨FileListBox æ§ä»¶æ¥è·åæå®æ件夹å çæææ件åã
FileListBox æ§ä»¶ï¼å¨è¿è¡æ¶ï¼å¨ Path å±æ§æå®çç®å½ä¸ï¼FileListBox æ§ä»¶å°æ件å®ä½å¹¶å举åºæ¥ã该æ§ä»¶ç¨æ¥æ¾ç¤ºæéæ©æ件类åçæ件å表ãä¾å¦ï¼å¯ä»¥å¨åºç¨ç¨åºä¸å建对è¯æ¡ï¼éè¿å®éæ©ä¸ä¸ªæ件æè ä¸ç»æ件ã
以ä¸æ¯ç»å使ç¨DriveListBox ãæ§ä»¶DirListBox æ§ä»¶åFileListBox æ§ä»¶æ¥è·å硬çä¸ä»»ä½ä¸ä¸ªæ件夹å çæ件åã
Private Sub Dir1_Change()File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
Dim i As Long
Debug.Print "ç®å½å¤¹å åå¨" & File1.ListCount & "个æ件ã"
End Sub
1.建立一个窗体
2.放置一个文本框,用于输入索引路径,文本框命名为txtDirPath
3.放置一个按钮,用于开始索引,按钮命名为cmdSearch
4.放置一个Label,用于显示索引进度,命名为lblState
5.放置一个Command按钮,用于保存索引结果,命名为cmdSave
程序代码如下:
Dim searchingPath As String
Dim pl As Long
Dim finalOut As String
Dim c As Long
Private Sub cmdSave_Click()
Open "c:\out.txt" For Output As #1
Print #1, finalOut
Close #1
lblState.Caption = "保存完成! 已经写入到C:\Out.txt": DoEvents
End Sub
Private Sub cmdSearch_Click()
c = 0
If Right(txtDirPath.Text, 1) <> "\" Then txtDirPath.Text = txtDirPath.Text + "\"
pl = Len(txtDirPath.Text)
SearchFile txtDirPath.Text
End Sub
Private Sub Form_Load()
Me.Show
txtDirPath.SetFocus
txtDirPath.SelStart = Len(txtDirPath.Text)
End Sub
Private Sub txtDirPath_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then cmdSearch_Click
End Sub
Sub SearchFile(strPath As String)
On Error Resume Next
Dim strName As String
Dim dir_i() As String
Dim i As Long, idir As Long
Dim showStr As String
If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
strName = Dir(strPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
Do While Len(strName) > 0
If strName <> "." And strName <> ".." Then
If (GetAttr(strPath & strName) And vbDirectory) = vbDirectory Then
idir = idir + 1
ReDim Preserve dir_i(idir) As String
dir_i(idir - 1) = strName
Else
c = c + 1
showStr = Replace(Mid(strPath, pl + 1), "\", "><")
finalOut = finalOut + "<" + Left(showStr, Len(showStr) - 1) + strName + vbCrLf
End If
End If
strName = Dir
If searchingPath <> strPath Then
lblState.Caption = "索引数: " & CStr(c) & ",搜索目录: " & strPath
searchingPath = strPath
DoEvents
End If
Loop
For i = 0 To idir - 1
Call SearchFile(strPath + dir_i(i))
Next i
Erase dir_i
lblState.Caption = "搜索完成,总计文件数: " & CStr(c)
End Sub本回答被提问者和网友采纳
Dim ctFind As Boolean
Private Sub Command2_Click()
If List1.ListCount = 0 Then Exit Sub
Dim lngHandle As String
Dim a() As String
Dim strline As String
lngHandle = FreeFile()
Open "d:\temp.txt" For Output As lngHandle
For I = 0 To List1.ListCount - 1
If Right(List1.List(I), 1) <> "/" Then
strline = ""
a = Split(List1.List(I), "\")
For n = UBound(a) - 1 To 1 Step -1
If a(n) <> "" Then
strline = "<" & a(n) & ">" & strline
End If
Next
strline = strline & a(UBound(a))
If a(UBound(a)) <> "" Then
Print #lngHandle, , strline
End If
End If
Next
Close #lngHandle
End Sub
Private Sub Form_Load()
Me.Caption = "查找所有文件及文件夹"
Command1.Caption = "查找"
List2.Visible = False: File1.Visible = False: Dir1.Visible = False
Label1.Caption = "就绪"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub Form_Resize()
Dim W As Long
On Error Resume Next
W = 720
List1.Move 0, 0, Me.ScaleWidth - W - 120, Me.ScaleHeight - 300
Command1.Move Me.ScaleWidth - W - 60, 300, W
Label1.Move 90, Me.ScaleHeight - 255, Screen.Width, 255
End Sub
Private Sub Command1_Click()
ctFind = Not ctFind
If ctFind Then
Command1.Caption = "取消"
Call FindDirFile("d:\downloads") '**查找 C:\ 下的所有文件和目录,或 C:\Windows 等
Command1.Caption = "查找"
Else
Command1.Caption = "查找"
End If
End Sub
Private Sub FindDirFile(ByVal nPath As String)
Dim I As Long, nDir As String, Ci As Long
ctFind = True
List1.Clear: List2.Clear
If Right(nPath, 1) <> "\" Then nPath = nPath & "\"
List1.AddItem "查找 " & nPath: List2.AddItem nPath
File1.Pattern = "*"
File1.System = True: File1.Hidden = True: File1.ReadOnly = True
On Error GoTo Cuo
Dir1.Path = nPath
On Error GoTo 0
Do
If List2.ListCount = 0 Then Exit Do
nPath = List2.List(0)
List2.RemoveItem 0
Dir1.Path = nPath
For I = 0 To Dir1.ListCount - 1
GoSub ShowGe
nDir = Dir1.List(I)
If Right(nDir, 1) <> "\" Then nDir = nDir & "\"
List1.AddItem "■" & nDir
List2.AddItem nDir
Next
File1.Path = nPath
For I = 0 To File1.ListCount - 1
GoSub ShowGe
List1.AddItem " " & nPath & File1.List(I)
Next
Loop
Label1.Caption = "查找完毕,共找到 " & List1.ListCount & " 个条目"
ctFind = False
Exit Sub
Cuo:
List1.AddItem "起始目录不存在:" & nPath
ctFind = False
Exit Sub
ShowGe:
Ci = Ci + 1
If Ci < 99 Then Return
Ci = 0
Label1.Caption = "已找到 " & List1.ListCount & " 个:" & nPath
DoEvents
If ctFind Then Return
End Sub
Private Sub List1_Click()
MsgBox List1.List(List1.ListIndex)
Dim a() As String
a = Split(List1.List(List1.ListIndex), "\")
For I = 0 To UBound(a)
MsgBox a(I)
Next
End Sub
人家讲的表较详细。以前我写过类似的
不过从重装的系统没了