急啊！哪位可以给我一个递归实现访问某个磁盘的某个目录（由用户指定）以下的文件和目录以及获得相对与该目录的层数的源代码啊！！？？

Question

各位大哥大姐。帮帮忙，急啊。我刚开始学习vb，懂的不多啊！！！

Answer 1

没有人知道么？？？
那么改一个问题，如何把一个listiew里面的文件夹和文件按次序添加一个前缀呢？？？
前缀从“w001”开始。
这是一个按钮时间完成的操作！！！
求求各位了，哪位可以提供啊。。

Answer 2

递归过程实现的思路：  
简言之，递归过程就是子程序自己调用自己。由于磁盘上的目录是树形结构，而树形的节点和节点级数是不受限定的，仅把目录名放入一维或多维数组中难度较大，不易实现。编一子程序，给定目录，并建立当前节点，加入Node对象中，根据Dir1控件判断给定目录下是否有下级目录，如有，添加下级节点，并加入Node对象中如无则退出子程序。即子程序的功能是：如给定目录有子目录，则展开当前目录求子目录。如果在给定目录展开完成后，把下级目录当成给定目录，并调用子程序进行展开,即可把给定目录下的数级子目录全部展开完毕。下面就举例说明，为简便起见，TreeView控件只放入目录，文件名省略。 
实现的过程： 
1、 添加TreeView控件到窗体中：单击—“工程”—“部件”，选择Microsoft Windows Common Control 6.0”(文件路径为\WinNT\System32\Mscomctl.ocx)复选框，单击—“确定“按钮，TreeView控件即可出现在工具箱中并添加。 
2、 在窗体中添加Drive、DirListBox、ImageList控件。 
3、 控件名及主要属性如下： 
控件及窗体名
 主要属性值
 备注
 
Form
 Name=Form1:Caption=”测试窗体”
 
 
TreeView
 Name=TreeView1
 
 
Drive
 Name=Drive1:Visible=False
 获得当前电脑磁盘的盘符
 
DirListBox
 Name=Dir1:Visible=False
 
 
ImageList
 Name=ImageList1
 给TreeView1的Node对象图标
 
 
在应用程序当前目录下，放入一16X16的位图文件123.bmp，供TreeView1控件显示用。 
实现的源程序如下： 
Option Explicit '必须进行变量声明 
Dim nodx As Node 
Private Sub Form_Load() 
On Error Resume Next 
'控件与窗体一样大 
TreeView1.Height = Form1.ScaleHeight 
TreeView1.Width = Form1.ScaleWidth 
'在 ImageList 控件中添加一个图象,该图像用于显示在TreeView1控件上。 
Dim imgX As ListImage 
'调入图形文件 
Set imgX = ImageList1.ListImages.Add(, , LoadPicture("123.bmp")) 
TreeView1.ImageList = ImageList1 '初始化ImageList。 
TreeView1.LineStyle = tvwRootLines 
TreeView1.Style = tvwTreelinesPlusMinusPictureText 
Dim DriverCount As Integer 
Dim GivePath As String 
'创建根节点 
Set nodx = TreeView1.Nodes.Add(, , "本人电脑", "本人电脑", 1) 
For DriverCount = 0 To Drive1.ListCount - 1 
GivePath = Left(Drive1.List(DriverCount), 2) + "\" 
Set nodx = TreeView1.Nodes.Add("本人电脑", tvwChild, GivePath, GivePath, 1) 
SSplitNode GivePath '把各盘的文件夹进行展开放于TreeView1控件中 
Next DriverCount 
End Sub 
Sub SSplitNode(sGivePath As String) '子过程 
'把给定目录下的子目录全部加入Node对象中 
Dim SDI As Integer 
Dim SDCount As Integer 
'用于存放给定目录的下级子目录，该变量数组随递归过程调用而发生变化 
Dim GivePathSubDir() As String 
'如有则展开目录并放入TreeView1控件中 
Dir1.Path = sGivePath 
SDCount = Dir1.ListCount 
If SDCount <> 0 Then 
ReDim GivePathSubDir(SDCount - 1) 
'把下级目录放入变量数组GivePathSubDir中 
SubSaveSubDir sGivePath, GivePathSubDir, SDCount 
End If 
If SDCount = 0 Then Exit Sub 
'即为递归出口。否则会形成死循环。 
For SDI = 0 To SDCount - 1 
Set nodx = TreeView1.Nodes.Add(sGivePath, tvwChild, _ 
GivePathSubDir(SDI), FOnlyPath(GivePathSubDir(SDI)), 1) 
Next SDI 
'调用递归(子程序自己调用自己) 
For SDI = 0 To SDCount - 1 
sGivePath = GivePathSubDir(SDI) 
SSplitNode sGivePath 
Next SDI 
End Sub 
Sub SubSaveSubDir(fGivePath As String, fGivePathSubDir() As String, fSDCount As Integer) 
'fGivePath 给定目录串 
'fGivePathSubDir 用于存放子目录 
'fSDCount 子目录数 
Dim i As Integer: Dim t As Integer 
Dir1.Path = fGivePath 
t = Dir1.ListCount 
For i = 0 To t - 1 
fGivePathSubDir(i) = Dir1.List(i) 
Next i 
fSDCount = t 
End Sub 
Function FOnlyPath(DString As String) As String 
'功能是去掉上级目录，只留下当前目录名 
'DString为给定的全路径目录名 
If DString = "" Then Exit Function 
Dim DLength As Integer 
DLength = Len(DString) 
Dim DD As Integer 
For DD = DLength To 1 Step -1 
If Mid(DString, DD, 1) = "\" Then Exit For 
Next DD 
FOnlyPath = Mid(DString, DD + 1) 
End Function 
Private Sub Form_Resize() 
'控件与窗体一样大 
TreeView1.Height = Form1.ScaleHeight 
TreeView1.Width = Form1.ScaleWidth 
End Sub 

Answer 3

kbkingbird(丁翊)
先谢谢你，
但是我把你给我的程序贴过去，treeview怎么没有任何内容啊？？？
也就是没有目录和文件被查出来。
是不是忘了一些内容啊？？
这个程序只是对目录进行操作，我还要求把文件一起进行操作。
把文件和目录一起进行改名。
麻烦再进一步帮帮忙哈！！！！！谢谢谢谢

Answer 4

专为楼主写的递归算法，用的filesystemobject这个知道怎么用吧，就不详细介绍了，另外我在窗体上加了两个listbox用来显示，代码如下：
Private Sub bianli(g_path As String)
Dim fso As New FileSystemObject
Dim k As Folder
Dim g_Folder As Folder
Set k = fso.GetFolder(g_path)
Dim i As Integer
If k.SubFolders.Count > 0 Then
    For Each g_Folder In k.SubFolders
        List1.AddItem g_Folder.Name
        bianli (g_Folder.Path)
    Next
End If
Dim g_file As File
For Each g_file In k.Files
    List2.AddItem g_file.Name
Next
 
End Sub

Answer 5

惭愧啊，
虽然我基本上看懂了jornet(匆匆)你写的算法，但是却改不了，能不能将改名的一部分也加进去？？？
也就是每一层的文件夹和文件按次序加上一个“n001”,"noo2","noo3".....也就是第一个文件或者文件夹加上“n001“，第2个文件或者文件夹加上“n002“.....以此类推。
我再加些分。
先谢谢了！！！！

Answer 6

henhuaqi，我们都是新手啊
我也有很多地方不懂，希望高手来指教我
……

Answer 7

Public Function getff(folderpath As String)
Dim f, f1, f2, fc, S, nextfolder, f3, files
Dim fs As Object, file As file    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderpath)
    Set fc = f.SubFolders
    Set files = f.files
    If isgoing = True Then
    DoEvents
    For Each file In files
    If Right(file.Name, 3) = "old" Or Right(file.Name, 3) = "TMP" Or Right(file.Name, 3) = "??$" Or Right(file.Name, 3) = "??~" Or Right(file.Name, 3) = "~*" Or Right(file.Name, 3) = "bak" Or Right(file.Name, 3) = "chk" Or Right(file.Name, 3) = "ftg" Or Right(file.Name, 3) = "fts" Or Right(file.Name, 3) = "gid" Or Right(file.Name, 3) = "tmp" Or Right(file.Name, 3) = "_mp" Or Right(file.Name, 3) = "syd" Or Right(file.Name, 3) = "dir" Or Right(file.Name, 3) = "nch" Or Right(file.Name, 3) = "---" Or Right(file.Name, 3) = "@@@" Or Right(file.Name, 3) = "$$$" Then
    Form1.List1.AddItem file.Path
    End If
    Next
    For Each f1 In fc
    DoEvents
    If f1 <> "" Then
    If Right(folderpath, 1) = "\" Then
    Form1.Labeltishi.Caption = "正在扫描:" + folderpath + f1.Name
    getff (folderpath + f1.Name)
    Else
    Form1.Labeltishi.Caption = "正在扫描:" + folderpath + "\" + f1.Name
    getff (folderpath + "\" + f1.Name)
    End If
    End If
    Next
    End If
Form1.Labeltishi.Caption = "扫描结束！"
End Function

Answer 8

呵呵，有时候我觉得这上面的人好热心哦，都有点不好意思了。
我把刚才那个bianli算法改了一些，结果把我的磁盘文件改得乱七八糟。
大家帮我看看哪里有问题？？
我的要求是同一层的文件和文件夹所加的前缀都是具有一定的排序功能。
比如说有一个目录下面有文件夹a, b,c和文件e,f
加了前缀后就成了n001a,n002b,n003c和n004e,n005f就是这样的，
每一个子文件夹的前缀加法是一样的。
Private Sub bianli(g_path As String)
Dim fso As New FileSystemObject
Dim k As Folder
Dim g_Folder As Folder
Set k = fso.GetFolder(g_path)
Dim i As Integer
If k.SubFolders.Count > 0 Then
    Dim z As Integer
    
     z = 1
    For Each g_Folder In k.SubFolders
       Dim cs1 As String
       Dim cs As String
         cs1 = CStr(z)
         If 3 - Len(cs1) = 0 Then
           cs = cs1
           Else
            If 3 - Len(cs1) = 1 Then
              cs = "0" & cs1
              Else
              cs = "00" & cs1
            End If
          End If
        If Mid(g_Folder.Name, 1, 4) <> "n" & cs Then
            g_Folder.Name = "n" & cs + g_Folder.Name
        End If
        List1.AddItem g_Folder.Name
        z = z + 1
        bianli (g_Folder.Path)
    Next
End If
Dim g_file As File
For Each g_file In k.Files
    List1.AddItem g_file.Name
Next
 
End Sub
高手们多多帮助我们这些新手，新手也努力学习，争取进步。

Answer 9

你有MSDN吗？其中VB的例子Winseek就是实现你所说的功能。

Answer 10

really？？？ok let me see!!
谢谢。

Answer 11

添加一个TreeView和一个commandbuttonConst MAX_PATH = 260
Const FILE_ATTRIBUTE_DIRECTORY = &H10Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePrivate 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 * MAX_PATH
    cAlternate As String * 14
End TypePrivate 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 LongPrivate Type DirInfo
    DirName     As String
End TypeSub FindDirs(D$, T As TreeView)
    Dim nx As Node, C$
    C$ = CurDir$
    ChDir D$
    If Len(Dir$("*.*", vbDirectory)) Then
        On Local Error Resume Next
        ChDir ".."
        ChDir ".."
        Set nx = T.Nodes.Add(CurDir$, 4, C$, LastPath$(C$))
        If Err Then
            Set nx = T.Nodes.Add(, , C$, C$)
        End If
        ChDir C$
        ChDir D$
        Set nx = T.Nodes.Add(C$, 4, , D$)
    Else
        Set nx = T.Nodes.Add(C$, 4, , D$)
    End If
    DoEvents
    Dim N As Integer, Srch$, i As Integer, NewD$
    Srch$ = "*.*"
    ReDim Dees(1 To 10) As DirInfo
    Call LoadDirs(Dees(), N, Srch$)
    If N = 0 Then
        ChDir ".."
        Exit Sub
    End If    
    For i = 1 To N
        NewD$ = RTrim$(Dees(i).DirName)
        Call FindDirs(NewD$, T)
    Next
    
    ChDir ".."
End SubFunction LastPath$(P$)
    Dim i
    For i = Len(P$) To 1 Step -1
        If Mid$(P$, i, 1) = "\" Then
            LastPath$ = Mid$(P$, i + 1)
            Exit For
        End If
    Next
End FunctionPrivate Sub LoadDirs(D() As DirInfo, N As Integer, Srch$)
    Dim a$, Max As Integer, i As Integer, k As Integer, W32 As WIN32_FIND_DATA, fHandle As Long, lResult As Long
    Max = UBound(D)
    N = 0
    fHandle = FindFirstFile(Srch$, W32)
    If fHandle Then
        Do
            a$ = Left$(W32.cFileName, InStr(W32.cFileName, Chr$(0)) - 1)
            If a$ <> "." And a$ <> ".." And ((W32.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) > 0) Then
                N = N + 1
                If Max < N Then
                    Max = Max + 10
                    ReDim Preserve D(1 To Max) As DirInfo
                End If
                D(N).DirName = a$
            End If
            DoEvents
            lResult = FindNextFile(fHandle, W32)
        Loop While lResult
        lResult = FindClose(fHandle)
    End If    For i = 1 To N - 1
        For k = i + 1 To N
            If D(i).DirName > D(k).DirName Then
                a$ = D(k).DirName
                D(k).DirName = D(i).DirName
                D(i).DirName = a$
            End If
        Next
    Next
End SubPrivate Sub Command1_Click()
    Static done
    If done Then Exit Sub
    done = True
    ChDrive "I:\新建文件夹"
    ChDir "I:\新建文件夹"
    Call FindDirs("I:\新建文件夹", TV)
    MsgBox "完毕！请双击根目录开始访问！"
End SubPrivate Sub Form_Unload(Cancel As Integer)
    End
End Sub
层次清楚

Answer 12

lostionsoft(lostionsoft)的程序我完全看不懂。呵呵，看来我基础太浅了。danielinbiti(金)，我看了你给我的程序，我这里有一个一样的，呵呵，它只是列出了全部文件夹而没有列出文件。
我现在的过程对于给文件夹加前缀是正确的，可是文件名确实错误的。我贴出来各位帮我看看是哪里出错了。Private Sub bianli(g_path As String)
Dim fso As New FileSystemObject
Dim k As Folder
Dim g_Folder As Folder
Set k = fso.GetFolder(g_path)
Dim i As Integer
If k.SubFolders.Count > 0 Then
    Dim z, q As Integer
    
     z = 1
    For Each g_Folder In k.SubFolders
       Dim cs1 As String
       Dim cs As String
         cs1 = CStr(z)
         q = 3 - Len(cs1)
         Select Case q
         Case 0
              cs = cs1
         Case 1
              cs = "0" & cs1
         Case 2
              cs = "00" & cs1
         Case Else
         End Select
      
        If Mid(g_Folder.Name, 1, 4) <> "n" & cs Then
            g_Folder.Name = "n" & cs + g_Folder.Name
        End If
        List1.AddItem g_Folder.Name
        z = z + 1
        bianli (g_Folder.Path)
    Next
End If
Dim g_file As File
Dim t, j As Integer
If k.Files.Count > 0 Then
     t = k.SubFolders.Count + 1
 For Each g_file In k.Files
   Dim cs3 As String
       Dim cs4 As String
         cs3 = CStr(t)
         j = 3 - Len(cs1)
         Select Case j
         Case 0
              cs4 = cs3
         Case 1
              cs4 = "0" & cs3
         Case 2
              cs4 = "00" & cs3
         Case Else
         End Select
        If Mid(g_file.Name, 1, 4) <> "n" & cs4 Then
            g_file.Name = "n" & cs4 + g_file.Name
        End If
    List1.AddItem g_file.Name
    t = t + 1
Next
End If
End Sub

Answer 13

大家帮我看看如何判断，这个过程是实现将已添加前缀的文件夹和文件的前缀去掉，去掉的时候就会遇到出现文件名同名的情况。这个问题怎么处理？？？
帮帮忙看看了，谢谢！！Private Sub reset(g_path As String)
Dim fso1 As New FileSystemObject
Dim j As Folder
Dim g_Folder As Folder
Set j = fso1.GetFolder(g_path)
Dim i As Integer
If j.SubFolders.Count > 0 Then
     For Each g_Folder In j.SubFolders
           If Mid(g_Folder.Name, 1, 1) = "w" And IsNumeric(Mid(g_Folder.Name, 2, 3)) Then
     g_Folder.Name = Mid(g_Folder.Name, 5, Len(g_Folder.Name) - 4)
       List1.AddItem g_Folder.Name
    Else
        List1.AddItem g_Folder.Name
         End If
        reset (g_Folder.Path)
    Next
End If
Dim g_file As File
'Dim t, j As Integer
If j.Files.Count > 0 Then
 For Each g_file In j.Files   If Mid(g_file.Name, 1, 1) = "w" And IsNumeric(Mid(g_file.Name, 2, 3)) Then
       g_file.Name = Mid(g_file.Name, 5, Len(g_file.Name) - 4)
        List1.AddItem g_file.Name
      Else
        List1.AddItem g_file.Name
        End If
 Next
End If
End Sub

Answer 14

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox List2 
      Height          =   1620
      Left            =   2160
      TabIndex        =   3
      Top             =   1320
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "ok"
      Height          =   375
      Left            =   3000
      TabIndex        =   2
      Top             =   480
      Width           =   855
   End
   Begin VB.ListBox List1 
      Height          =   1815
      Left            =   720
      TabIndex        =   1
      Top             =   1200
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   480
      TabIndex        =   0
      Top             =   480
      Width           =   1935
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim g_Depart As Integer
Dim s As StringPrivate Sub bianli(g_path As String)
Dim fso As New FileSystemObject
Dim k As Folder
Dim g_Folder As Folder
Set k = fso.GetFolder(g_path)
Dim i As Integer
g_Depart = g_Depart + 1
If k.SubFolders.Count > 0 Then
    For Each g_Folder In k.SubFolders
        
        g_Folder.Name = g_Folder.Name & "n000" & g_Depart
        List1.AddItem g_Folder.Name
        
        bianli (g_Folder.Path)
    Next
End If
Dim g_file As File
For Each g_file In k.Files
    g_file.Name = g_file.Name & "n000" & g_Depart
    List2.AddItem g_file.Name
Next
 
End Sub
Private Sub Command1_Click()
bianli (Text1.Text)
End SubPrivate Sub Form_Load()
g_Depart = 0
End Sub
-----------------------------------
你把这个保存到文本文件，然后把扩展名改成frm
我不知道你是不是这个意思，如果有问题，再发短消息给我

Answer 15

jornet(匆匆)我真的非常感谢你了，因为你的算法帮我解决了大部分问题。
现在就是还有一个问题，就是在我8月15回的帖子上说关于判断文件是否重名的情况，那是为文件加前缀的反操作去掉前缀所需要解决的问题。
我不知道如何判断，麻烦帮我看一看。

Answer 16

我大楷写了下，但没调试，可能有些小错误，不过算法简单，我想搂主能看懂，我的大楷意思是如果出现重名，调用g_rename函数，把需要重新命名的文件夹名字加上（i）,i是个变量。windows好像就是这样解决的
Private Sub Rov(p_path As String)Dim k As Folder
Dim g_Folder As Folder
Set k = fso.GetFolder(g_path)
Dim i As Integer
g_Depart = g_Depart + 1
If k.SubFolders.Count > 0 Then
    For Each g_Folder In k.SubFolders
        If InStr(1, g_Folder.Name, "n000") Then
            Dim t As Integer
            t = 0
            g_name = Mid(g_Folder.Name, 1, Len(s) - 4)
            If fso.FileExists(p_path & s) Then
                g_Folder.Name = g_rename(k.Path, g_name)
            Else
                g_Folder.Name = g_name
            End If
        'g_Folder.Name = g_Folder.Name & "n000" & g_Depart
        List1.AddItem g_Folder.Name
        
        Rov (g_Folder.Path)
    Next
End If
Dim g_file As File
For Each g_file In k.Files
            t = 0
            g_name = Mid(g_file.Name, 1, Len(s) - 4)
            If fso.FileExists(k.Path & g_name) Then
                g_file.Name = g_rename1(k.Path, g_name)
            Else
                g_file.Name = g_name
            End If
    List2.AddItem g_file.Name
NextEnd SubPrivate Function g_rename(p_path As String, s As String) As String
    Dim w As String
    
    Do While (1)
        t = t + 1
        w = s
        w = w & "(" & t & ")"
        If Not fso.FolderExists(p_path & w) Then
                g_rename = w
                Exit Do
        End If
    Loop
End Function
                
Private Function g_rename1(p_path As String, s As String) As String
    Dim w As String
    
    Do While (1)
        t = t + 1
        w = s
        w = w & "(" & t & ")"
        If Not fso.FileExists(p_path & w) Then
                g_rename = w
                Exit Do
        End If
    Loop
End Function

Answer 17

jornet(匆匆) 
我把你写的加进去，但是还是有错，每次都是提示文件名已存在。你看看是怎么回事？？
Private Sub reset(g_path As String)
    Dim fso1 As New FileSystemObject
    Dim j As Folder
    Dim g_Folder As Folder
    Set j = fso1.GetFolder(g_path)
    Dim i As Integer
    'm_label2.Caption = j.Files.Count
    If j.SubFolders.Count > 0 Then
     
       For Each g_Folder In j.SubFolders
                
        If Mid(g_Folder.Name, 1, 1) = "w" And IsNumeric(Mid(g_Folder.Name, 2, 3)) Then
                      Dim s As String
            Dim g_name As String
            s = g_Folder.Name
            g_name = Mid(g_Folder.Name, 5, Len(s) - 4)
            If fso1.FolderExists(j.Path & g_name) Then
                g_Folder.Name = g_rename(j.Path, g_name)
            Else
                g_Folder.Name = Mid(g_Folder.Name, 5, Len(s) - 4)
            End If
         
        End If
            reset (g_Folder.Path)
        Next
    End If
    Dim g_file As File
      If j.Files.Count > 0 Then
                   For Each g_file In j.Files
        
          If Mid(g_file.Name, 1, 1) = "w" And IsNumeric(Mid(g_file.Name, 2, 3)) Then
                     Dim s1 As String
                     Dim g_name1 As String
                     s1 = g_file.Name
                     g_name1 = Mid(g_file.Name, 5, Len(s1) - 4)
                     If fso1.FileExists(j.Path & g_name1) Then
                         g_file.Name = g_rename1(j.Path, g_name1)
                     Else
                         g_file.Name = g_name1
                     End If                       List1.AddItem g_file.Name
                    
                Else
                     List1.AddItem g_file.Name
                                    End If
         Next
    End If
End Sub

Answer 18

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4950
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7095
   LinkTopic       =   "Form1"
   ScaleHeight     =   4950
   ScaleWidth      =   7095
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "rov"
      Height          =   375
      Left            =   3840
      TabIndex        =   4
      Top             =   480
      Width           =   855
   End
   Begin VB.ListBox List2 
      Height          =   1815
      Left            =   3600
      TabIndex        =   3
      Top             =   1440
      Width           =   2895
   End
   Begin VB.CommandButton Command1 
      Caption         =   "ok"
      Height          =   375
      Left            =   2640
      TabIndex        =   2
      Top             =   480
      Width           =   855
   End
   Begin VB.ListBox List1 
      Height          =   2010
      Left            =   480
      TabIndex        =   1
      Top             =   1200
      Width           =   2535
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   480
      TabIndex        =   0
      Top             =   480
      Width           =   1935
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim g_Depart As Integer
Dim s As String
Dim fso As New FileSystemObject
Private Sub bianli(g_path As String)Dim k As Folder
Dim g_Folder As Folder
Set k = fso.GetFolder(g_path)
Dim i As Integer
g_Depart = g_Depart + 1
If k.SubFolders.Count > 0 Then
    For Each g_Folder In k.SubFolders
        
        g_Folder.Name = "n000" & g_Depart & g_Folder.Name
        List1.AddItem g_Folder.Name
        
        bianli (g_Folder.Path)
    Next
End If
Dim g_file As File
For Each g_file In k.Files
    g_file.Name = "n000" & g_Depart & g_file.Name
    List2.AddItem g_file.Name
Next
 
End Sub
Private Sub Command1_Click()
bianli (Text1.Text)
End SubPrivate Sub Command2_Click()
Rov (Text1.Text)
End SubPrivate Sub Form_Load()
g_Depart = 0
End Sub
Private Sub Rov(p_path As String)Dim k As Folder
Dim g_Folder As Folder
Set k = fso.GetFolder(p_path)
Dim i As Integer
g_Depart = g_Depart + 1
If k.SubFolders.Count > 0 Then
    For Each g_Folder In k.SubFolders
        If InStr(1, g_Folder.Name, "n000") Then
            Dim t As Integer
            Dim g_Name As String
            t = 0
            g_Name = Mid(g_Folder.Name, 5, Len(g_Folder.Name) - 4)
            If fso.FileExists(p_path & g_Name) Then
                g_Folder.Name = g_rename(k.Path, g_Name)
            Else
                g_Folder.Name = g_Name
            End If
        End If
        'g_Folder.Name = g_Folder.Name & "n000" & g_Depart
        List1.AddItem g_Folder.Name
        
        Rov (g_Folder.Path)
    Next
End If
Dim g_file As File
For Each g_file In k.Files
        If InStr(1, g_file.Name, "n000") Then
            t = 0
            g_Name = Mid(g_file.Name, 5, Len(g_file.Name) - 4)
            If fso.FileExists(k.Path & g_Name) Then
                g_file.Name = g_rename1(k.Path, g_Name)
            Else
                g_file.Name = g_Name
            End If
        
        End If
    List2.AddItem g_file.Name
NextEnd SubPrivate Function g_rename(p_path As String, s As String) As String
    Dim w As String
    
    Do While (1)
        t = t + 1
        w = s
        w = w & "(" & t & ")"
        If Not fso.FolderExists(p_path & w) Then
                g_rename = w
                Exit Do
        End If
    Loop
    
End Function
                
Private Function g_rename1(p_path As String, s As String) As String
    Dim w As String
    
    Do While (1)
        t = t + 1
        w = s
        w = w & "(" & t & ")"
        If Not fso.FileExists(p_path & w) Then
                g_rename1 = w
                Exit Function
        End If
    Loop
End Function-----------------------------------
你把这个保存到文本文件，然后把扩展名改成frm
这个我调试过，不会出现搂住的情况

Answer 19

谢谢，我也基本上改过来了，不过我发现一个问题就是对文件名的处理。
当我发现文件重名的时候就加一个后缀嘛，但是家了之后发现是在扩展名后面加的。
然后我想去掉扩展名再加，扩展名长度不确定。
windows上面好象不会出现这种情况哈。不晓得是怎样的呢。

Answer 20

private function rename(filename as string) as string
    dim i as interger
    i=instr(filename,1,".")
    rename=mid(filename,1,i) & "(" & i & ")" & mid(filename,i,len(filename)-i)
end function这是我直接在上面写的，没有调试，不过简单，估计你也看的懂，提个思路而