循环备份碰到问题求教代码修改

小铁匠

从数据库“备份”表里读出源文件与目标文件夹是，然后在目标文件夹里存20个备份文件，循环备份。请高手指教下面的代码错误，如何修改。

Dim conn As ADODB.Connection
        Set conn = CurrentProject.Connection
        Dim rst As New ADODB.Recordset
        Dim strsql As String
      Dim TemPath As String
   Dim StrFileName As String
  Dim strDBFileName     As String
        strsql = "SELECT  top 1 源文件, 备份文件 FROM 备份"
        rst.Open strsql, conn, 1, 1
If Not IsNull(rst("源文件")) And Not IsNull(rst("备份文件")) Then

strDBFileName = Format(Year(Now), yyyy) & Format(Month(Now), mm) & Format(Day(Now), dd) & Format(Hour(Now), hh) & Format(Minute(Now), mm) & ".mdb"
Dim fs
   
   Set fs = Application.FileSearch
   TemPath = rst("备份文件") & "\"

       fs.LookIn = rst("备份文件")
       fs.Filename = "*.mdb"
                     
        If fs.foundfiles.Count > 20 Then
        
        StrFileName = DMin(Left(fs.Filename, 12))
        
          Kill TemPath & StrFileName & ".mdb"
        End If
         
        FileCopy rst("源文件"), TemPath & strDBFileName

      
      End If
      
  rst.Close
        Set rst = Nothing
       Set conn = Nothing

zhouyunliang

要写出什么错误？能更有效地解决问题

小铁匠

找出最先的文件名是否可以用Dmin函数
StrFileName = DMin(Left(fs.Filename, 12))
还有这些代码调试中提示好几处错误

zhouyunliang

Sub BackUp()

    Dim conn As ADODB.Connection
    Set conn = CurrentProject.Connection
    Dim rst As New ADODB.Recordset
    Dim strsql As String
    Dim TemPath As String
    Dim StrFileName As String
    Dim strDBFileName As String
    strsql = "SELECT  top 1 源文件, 备份文件 FROM 备份"
    rst.Open strsql, conn, 1, 1
    If Not IsNull(rst("源文件")) And Not IsNull(rst("备份文件")) Then

        strDBFileName = Format(Year(Now), yyyy) & Format(Month(Now), mm) & Format(Day(Now), dd) & Format(Hour(Now), hh) & Format(Minute(Now), mm) & ".mdb"
        Dim fs

        Set fs = Application.FileSearch
        TemPath = rst("备份文件") & "\"

        fs.LookIn = rst("备份文件")
        fs.FileName = "*.mdb"
        Dim I As Integer
        I = fs.Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) - 20
        While fs.FoundFiles.Count > 0
            Kill TemPath & fs.FoundFiles(I)
            I = I - 1
        Wend
        FileCopy rst("源文件"), TemPath & strDBFileName
    End If

    rst.Close
    Set rst = Nothing
    Set conn = Nothing
End Sub

zhouyunliang

While I> 0

小铁匠

谢谢楼上指点，出现运行错误“9”，下标越界，
Set fs = Application.FileSearch
        TemPath = rst("备份文件") & "\"
        fs.LookIn = rst("备份文件")
        fs.FileName = "*.mdb"
        Dim I As Integer
        I = fs.Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) - 20
        While fs.FoundFiles.Count > 0
            Kill TemPath & fs.FoundFiles(I)
            I = I - 1
        Wend
        FileCopy rst("源文件"), TemPath & strDBFileName

[ 本帖最后由 小铁匠 于 2008-1-29 12:04 编辑 ]