| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1784 人关注过本帖
标题:请帮忙看哈这个代码!
只看楼主 加入收藏
事业男儿
Rank: 2
等 级:论坛游民
帖 子:317
专家分:14
注 册:2007-4-25
结帖率:82.19%
收藏
已结贴  问题点数:20 回复次数:4 
请帮忙看哈这个代码!
以下代码是搜索摸个文件夹以及下一层文件内的文件数量,能否改成只统计某个文件内的文件夹名字,并保存。
程序代码:
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

搜索更多相关主题的帖子: 统计 文件夹 
2016-02-01 14:07
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:10 
    For i = 0 To idir - 1
        Call SearchFile(strPath + dir_i(i))
    Next i

搜索下一级,并且是使用的递归,如果你不向下搜索,去掉这3句就可以,
然后顺便把这三句用到的支持命令也去掉就是了。

IF中的三句注释掉就可以了
        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

授人于鱼,不如授人于渔
早已停用QQ了
2016-02-01 14:17
事业男儿
Rank: 2
等 级:论坛游民
帖 子:317
专家分:14
注 册:2007-4-25
收藏
得分:0 
谢谢版主这么块的速度
我刚刚在论坛找到了这个代码。
程序代码:
Option Explicit
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * 255
cAlternate As String * 14
End Type

Private Sub cmdFindFiles_Click()
Dim wfd As WIN32_FIND_DATA
Dim isFindHandle As Long
Dim FileCount As Long
Dim Out As Long
Dim fileName As String
Out = True
isFindHandle = FindFirstFile("d:\vb源码\*", wfd)
If isFindHandle <> -1 Then

Do While Out
fileName = StripNulls(wfd.cFileName)

If fileName <> "." And fileName <> ".." Then
FileCount = FileCount + 1
List1.AddItem fileName
End If

Out = FindNextFile(isFindHandle, wfd)
Loop
End If

FindClose isFindHandle

MsgBox "D:\vb源码\中共有文件与文件夹数:" & FileCount
End Sub

Private Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function




我主要是想将这个代码实现3个功能:
1、在List1里显示VB源码文件夹里各源码文件的名字。
2、双击所要打开的源码文件夹。
3、加一个查找文本框,可以根据输入的内容打开。

我相信有很多的新手都收集了很多的源码,在文件夹内一时半会找不到,通过读取-显示结果,选中-打开,这样来快速查找。


再次谢谢各位老师
2016-02-01 14:32
事业男儿
Rank: 2
等 级:论坛游民
帖 子:317
专家分:14
注 册:2007-4-25
收藏
得分:0 
回复 3楼 事业男儿
在顶一 下!
2016-02-04 23:22
jiszen
Rank: 2
等 级:论坛游民
帖 子:1
专家分:10
注 册:2015-4-14
收藏
得分:10 
顶一下,很实用的代码。
2016-02-05 10:07
快速回复:请帮忙看哈这个代码!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.051610 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved