请教：do while.....Loop语句的应用问题

bjcompass

备份文件目录中保存了数量不等的文件名格式为“yyyy-mm-dd hh.nn.bak"的备份文件。这段模块代码运行后如果备份文件数量大于允许数量MaxQty，则从最早日期开始删除多余的文件，并且再按照设定的备份文件保存方式删除不需要的文件。
    现在这段代码使用了file search方式，在2007中不能运行，请问各位老师：如果改成能够在07中运行的Do while......Loop 方式代码应该怎样写啊。我试了N多次都不成功，只好求教老师了，谢谢指教。
With Application.FileSearch
        .NewSearch
        .LookIn = BackupDir       'BackupDir是前面过程定义的备份文件存放目录
        .SearchSubFolders = False     
        .FileName = "*.bak"        '备份文件类型：“*。bak”
        If .Execute > 0 And MaxQty > 0 Then    'MaxQty是设定的备份文件最大允许数量   
            If .FoundFiles.Count + 1 > MaxQty Then     
                For n = 1 To (.Execute + 1 - MaxQty)  
                    Kill .FoundFiles(n)
                Next
            End If
        End If      
   
        Select Case BackupMode     'BackupMode 是保存备份文件方式，其中有三个值。
        Case conBackupModeSaveAll        '含义是保存全部文件
            .FileName = Format$(Now(), "yyyy-mm-dd hh.nn") & "*.bak"
        Case conBackupModeSaveEveryDay    '含义是每天只保存一个文件
            .FileName = Format$(Now(), "yyyy-mm-dd") & "*.bak"
        Case conBackupModeSaveEveryMonth   '含义是每月只保存一个文件
            .FileName = Format$(Date, "yyyy-mm") & "*.bak"
        End Select
        If .Execute > 0 Then      
            For n = 1 To .FoundFiles.Count
                Kill .FoundFiles(n)
            Next
        End If
   End With

williamwangc

我尝试使用数组。但是在确定数组最小值和删除数组元素的时候卡住了。首先上传组成定义数组的一个实例。

1. Dim fso As FileSystemObject
   
2. Dim objectFolder As Folder
   
3. Dim objectFile As File
   
4. Dim iFile As Integer
   
5. Dim iKill As Integer
   
6. Dim str_FolderPath As String
   
7. Dim NameOfDocx() As String
   
8. iFile = 1
   
9. str_FolderPath = CurrentProject.Path
   
10. Set fso = New FileSystemObject
    
11. Set objectFolder = fso.GetFolder(str_FolderPath)
    
12. For Each objectFile In objectFolder.Files
    
13.     If objectFile.Name Like "*.docx" Then
    
14.     ReDim Preserve NameOfDocx(iFile)
    
15.     NameOfDocx(iFile) = objectFile.Name
    
16.     'Debug.Print objectFile.Name
    
17.     iFile = iFile + 1
    
18.     End If
    
19. Next objectFile

复制代码

williamwangc

在这里我也想提几个问题：
1、按我原本的想法，本来想用数组的。那么如何用二维数组，并用二维数组找到创建时间最小值？
2、recordset.open最后两个参数的意义，以及选用不同值的区别。我总是有些似懂非懂的样子。尤其对recordset.recordcount或其他代码限制或影响。

williamwangc

经过努力，终于完成了楼主的问题。在这之中也碰到了不少问题，也有了一些想法，希望和版主及各位朋友探讨。好了废话少说，上代码和附件。

1. '首先引用Microsoft activeX  data object 2.8 和 Microsoft Scripting Runtime
   
2. '前面一个是引用ADODB.RECORDSET,后一个是引用FileSystemObject
   
3. Dim fso As FileSystemObject
   
4. Dim objectFolder As Folder
   
5. Dim objectFile As File
   
6. Dim rst As ADODB.Recordset
   
7. Dim str_FolderPath As String
   
8. Dim str_SQLDEL As String
   
9. Dim str_EarlistCreated As String
   
10. '找到所有文本所在文件夹
    
11. str_FolderPath = CurrentProject.Path & "/测试文本"
    
12. Set fso = New FileSystemObject
    
13. Set objectFolder = fso.GetFolder(str_FolderPath)
    
14. 
    
15. '删除[tbl_文件名和创建时间]表所有数据
    
16. str_SQLDEL = "Delete * From [tbl_文件名和创建时间]"
    
17. DoCmd.SetWarnings False
    
18. DoCmd.RunSQL str_SQLDEL
    
19. 
    
20. '用ADO连接[tbl_文件名和创建时间]
    
21. Set rst = New ADODB.Recordset
    
22. rst.Open "tbl_文件名和创建时间", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    
23. 
    
24. '利用FileSysytemObject中File的属性提取文件的文件名和文件创建时间，并加入[tbl_文件名和创建时间]表
    
25. For Each objectFile In objectFolder.Files
    
26.     If objectFile.Name Like "*.docx" Then
    
27.     rst.AddNew
    
28.     rst!文件名 = objectFile.Name
    
29.     rst!创建时间 = objectFile.DateCreated
    
30.     rst.Update
    
31.     End If
    
32. Next objectFile
    
33. rst.Close
    
34. 
    
35. '我不太懂锁定记录的原理是什么，不过如果以adOpenDynamic, adLockOptimistic这样的参数打开recordset,那么recordset.recordcount=-1
    
36. rst.Open "tbl_文件名和创建时间", CurrentProject.Connection, adOpenStatic, adLockPessimistic
    
37. '当记录数量>5就循环下面的操作
    
38. Do While rst.RecordCount > 5
    
39. 
    
40. rst.MoveFirst
    
41. 
    
42. '循环操作开始地方：找到建立时间的最小值，即最早建立的时间
    
43. str_EarlistCreated = DMin("创建时间", "tbl_文件名和创建时间")
    
44. '在记录中找到最早建立的文件所在的记录
    
45. Debug.Print str_EarlistCreated
    
46. rst.Find "创建时间='" & str_EarlistCreated & "'"
    
47. '删除这个文件
    
48. Kill str_FolderPath & "" & rst!文件名
    
49. '在表里面删除这条记录
    
50. rst.Delete
    
51. '回到第一条记录
    
52. rst.MoveFirst
    
53. 
    
54. Loop
    
55. '数据集关闭
    
56. rst.Close
    
57. 
    
58. End Sub
    

复制代码

ps.方法比较菜鸟，不够简便，楼主只要稍作改动就可使用，不过由于filesysyemobject的关系，只有2007可用。
40行可删除，重复了。

williamwangc

只是一个do...while的例子而已，和楼主的代码没关系。field是一个字段，例子一是一个删除字段的例子。

bjcompass

不好意思，我自我感觉第一菜，我徒有思路不会代码，就弄不懂roych版主代码里 CurrentDb.TableDefs("tbl2") 是一个虚拟建立的表吗？
还有下面一句，是删除备份目录里最早的文件吗？
CurrentDb.TableDefs("tbl2").Fields.Delete CurrentDb.TableDefs("tbl2").Fields (  CurrentDb.TableDefs("tbl2").Fields.Count - 1).Name

bjcompass

不过有一点比较纠结，filesystemobject是2007里面新加进去的，代替filesearch的方法。可能，或者应该说2007之前的版本不能识别这个

我的思路：2007只有少部分不兼容2003，遇到这种情况可以用
           If oApp.Version = "12.0" Then......end
                    If oApp.Version = "11.0" Then.....end  这样语句把适应2007 和2003的过程都写到模块里，2003时用filesearch方法,2007时用filesystemobject，这个模块和整个数据库都可以适应access2003或2007两个版本。

williamwangc

恩。的确。这样的办法可行。我虽然会写一般的窗体控件的代码。但ACCESS完全是自学,对VBA还只是菜鸟，也许楼上的基础比我好，我一直对模块和公共函数和公共过程写法找不到门路，特别是调试和纠错方面。一直想好好写一个复杂点的，但总是没怎么成功过。希望楼上写完之后可以发来看看，参考下。

roych

bjcompass 发表于 2012-5-13 12:38
不好意思，我自我感觉第一菜，我徒有思路不会代码，就弄不懂roych版主代码里 CurrentDb.TableDefs("tbl2")  ...

和williamwangc所说的一样，这里里面只是给出一个Do While的写法而已。
1、tbl2表是已经存在的。
2、CurrentDb.TableDefs("tbl2").Fields.Delete CurrentDb.TableDefs("tbl2").Fields (  CurrentDb.TableDefs("tbl2").Fields.Count - 1).Name
删除表tbl2最后一个字段。由于后面有Refresh方法，所以随时更新最后一个字段的名称，从而达到把全部字段删除完毕的目的。

williamwangc

在做数组的时候受excel的影响，以为可以做数组的min的。似乎vba里面弄数组是不能做min和max的。
我想把思路调整下，不使用数组，但把objectfile.name和objectfile.createtime分别做一个新表的两个列[name]和[createtime]。
然后使用dmin函数找出objectfile.createdate的最大值所在的RECORDSET
kiill currentproject & "/" & rst![name]
当然最后要用到do...lloop
参考前面for....each语句，做一下修改，建立新表和rst![name]=objectfile.name    rst![createtime]=objectfile.createtime。我这里就省略了。

最后kill这个过程大概是这样的：
dim rst as adodb.recordset
dim str_MinCreatetitme as string
set rst=new adodb.recordset
rst.open "tbNew",currentproject.connection,,               ‘后面几个参数我背不出来，这里就不写了。

do while rst.count>5      ’当记录数量>5就循环下面的操作
str_MinCreatetime=dmin("createtime" ,"tbNew",“nz(name)<>''”)  ‘循环操作开始地方：找到建立时间的最小值，即最早建立的时间
rst.find(“createtime="' & str_MinCreatetime &"'”)                       '在记录中找到最早建立的文件所在的记录
kill currentproject.path & "\" & rst![name]    '具体路径根据实际情况   ’删除这个文件
rst.delete                 ‘在表里面删除这条记录
rst.update                    '我不常用单条删除，这个命令不太熟，不知道是否需要update，不需要可删除。
rst.movefirst            ‘回到第一条记录
loop                         ’回到循环操作开始的地方
rst.close                  ‘数据集关闭
end sub                 ’结束