troubleshooting Question

Copy all files from one folder to another in vba

Avatar of Bushmouse
Bushmouse asked on
Microsoft Access
5 Comments2 Solutions781 ViewsLast Modified:
Ok experts, I'm back for more.  Make a long story short I need to copy all files from one folder to another.  I snooped around through the forum, found some code and plugged it into my database; however I keep getting an error:  Bad File for file number when the code executes.  The code is called from a form to a function in a module.  The actual FileCopy command line is highlighted when I click debug on the error.  All of the files are copied to the new directory like they should.  The hover text shows that strFullPath is = to ""  when the error appears.  I am thinking the following line should prevent that from happening:  Do While Len(strFullPath) > 0 ; however I still get the error.  Thanks in advance.

Form Code (seems to work fine)

Private Sub cmdFunctionExecute_Click()
    Dim MyParameter As String
    Dim blEval As Boolean
    Dim strEval As String
    Dim ClassID As Long
   
    ClassID = Me!ClassID
    MyParameter = Me!Function
    strEval = MyParameter & "(" & ClassID & ")"
    blEval = Eval(strEval)  
End Sub

Module Code (here where the error is"
Function CopyFiles(ClassID As Long) As Boolean

    Dim rsCurrentTT101Date As New ADODB.Recordset
    Dim strSQL
    Dim strMsg As String
    Dim CurrentTT101Date As Date
    Dim CurrentTT101Month As String
    Dim CurrentTT101Year As String
    Dim PreviousTT101Date As Date
    Dim PreviousTT101Month As String
    Dim PreviousTT101Year As String
    Dim CurrentDir As String
    Dim PreviousDir As String
    Dim strFullPath As String
    Dim strFileName As String
    Dim SourceFolder As String
    Dim DestinationFolder As String
    Dim FileExtension As String
       
    If Not IsNull(ClassID) Then
         strSQL = "SELECT * FROM qryClassAscending"
         rsCurrentTT101Date.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
         rsCurrentTT101Date.MoveFirst
         rsCurrentTT101Date.Find "ClassID = " & ClassID, , adSearchForward
         CurrentTT101Date = rsCurrentTT101Date![StartDate]
         rsCurrentTT101Date.MovePrevious
         PreviousTT101Date = rsCurrentTT101Date![StartDate]
               
         'Set Current Month and Date
         CurrentTT101Month = Format(CurrentTT101Date, "mmm")
         CurrentTT101Year = Year(PreviousTT101Date)
         
         'Set Previous Month and Date
         PreviousTT101Month = Format(PreviousTT101Date, "mmm")
         PreviousTT101Year = Year(PreviousTT101Date)
         
         CurrentDir = "Z:\ALL\TT101\" & CurrentTT101Month & " " & CurrentTT101Year & "\"
         PreviousDir = "Z:\ALL\TT101\" & PreviousTT101Month & " " & PreviousTT101Year & "\"
         
         rsCurrentTT101Date.Close
       
    Else
   
    End If

   
   
    SourceFolder = PreviousDir
    DestinationFolder = CurrentDir
   
    'make sure the trailing "\" exists
    If Right$(SourceFolder, 1) <> "\" Then
        SourceFolder = SourceFolder & "\"
    End If

    strFullPath = Dir$(SourceFolder)
        Do While Len(strFullPath) > 0
                strFullPath = Dir$
                strFileName = Mid$(strFullPath, InStrRev(strFullPath, "\") + 1)
                FileCopy SourceFolder & strFullPath, DestinationFolder & strFileName
        Loop

        strMsg = MsgBox("From:  " & PreviousDir & Chr$(13) + Chr$(10) & "To:  " & CurrentDir, vbOKOnly, "Files Copied From")
 
 Set rsCurrentTT101Date = Nothing
         strSQL = ""
         strMsg = ""
         CurrentTT101Date = 0
         CurrentTT101Month = ""
         CurrentTT101Year = ""
         PreviousTT101Date = 0
         PreviousTT101Month = ""
         PreviousTT101Year = ""
         PreviousDir = ""
         CurrentDir = ""
         SourceFolder = ""
         DestinationFolder = ""
         strFullPath = ""
         strFileName = ""

End Function
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 2 Answers and 5 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 2 Answers and 5 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros