sanders720
Programmer
A little difficult to follow here. I am reading a path and filename from a database field. I with to copy that as the source to a constant destination folder. I am using filecopy. The routine works, though it does not always complete the filecopy. In an example where there are 558 files to be copied, one time it did 48, another 120, etc. until Access locked up and when I exited the program got a "Access is not reponding error." There is a need at times to overwrite a file that perhaps already exists, but filecopy should simply do this according to my understanding. If this were a problem, it wouldn't explain why the program advances to different recordcounts prior to locking up. Is there another issue here with timing or something? Do I need to pause the program when performing filecopy for perhaps larger files, and where should I perform the pause. Or, do you forsee another cause to the problem?
If Me.cboSubAssy.Value <> "<ALL>" Then
sql_rsel = "SELECT tblPartsListing.PartLocation, tblPartsListing.PartNo FROM tblPartsListing INNER JOIN tblBOM ON tblPartsListing.PartNo=tblBOM.PartNo " & _
"WHERE (((tblBOM.JobNo) = " & Me.cboJobNo.Value & "
" & _
"AND ((tblBOM.SubAssy) = '" & Me.cboSubAssy.Value & "') " & _
"AND ((tblPartsListing.ManufacturedBy) = 'METRO MACHINE' )) "
Else
sql_rsel = "SELECT tblPartsListing.PartLocation, tblPartsListing.PartNo FROM tblPartsListing INNER JOIN tblBOM ON tblPartsListing.PartNo=tblBOM.PartNo " & _
"WHERE (((tblBOM.JobNo) = " & Me.cboJobNo.Value & "
" & _
"AND ((tblPartsListing.ManufacturedBy) = 'METRO MACHINE' )) "
End If
Set rs_rsel = CurrentDb.OpenRecordset(sql_rsel)
rs_rsel.MoveLast
y = rs_rsel.RecordCount
With rs_rsel
.MoveFirst
For z = 0 To y - 1
lblCounterStatus.ForeColor = 32768
lblCounterStatus.Caption = "Copying " & z + 1 & " of " & y
FileLocation2 = rs_rsel("PartLocation"![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
pn = rs_rsel("PartNo"![Wink ;) ;)](data:image/gif;base64,R0lGODlhAQABAIAAAAAAAP///yH5BAEAAAAALAAAAAABAAEAAAIBRAA7)
Debug.Print FileLocation2
Debug.Print pn
If FileLocation2 = "*** FILE NOT FOUND ***" Then
sa = "ALL"
Open "i:\newmanual\_" & Str(Me.cboJobNo.Value) & "_" & sa & "_files_not_found.txt" For Append As #1
Print #1, pn
Close #1
Else
CopyFile FileLocation2, pn
End If
.MoveNext
Next z
End With
End Function
Private Sub CopyFile(ByVal filename As String, ByVal file As String)
If Trim(filename) <> "" Then
'Set objCadApp = GetObject(filename)
Debug.Print filename
FileCopy filename, "i:\newmanual\" + file + ".dwg"
End If
End Sub
If Me.cboSubAssy.Value <> "<ALL>" Then
sql_rsel = "SELECT tblPartsListing.PartLocation, tblPartsListing.PartNo FROM tblPartsListing INNER JOIN tblBOM ON tblPartsListing.PartNo=tblBOM.PartNo " & _
"WHERE (((tblBOM.JobNo) = " & Me.cboJobNo.Value & "
"AND ((tblBOM.SubAssy) = '" & Me.cboSubAssy.Value & "') " & _
"AND ((tblPartsListing.ManufacturedBy) = 'METRO MACHINE' )) "
Else
sql_rsel = "SELECT tblPartsListing.PartLocation, tblPartsListing.PartNo FROM tblPartsListing INNER JOIN tblBOM ON tblPartsListing.PartNo=tblBOM.PartNo " & _
"WHERE (((tblBOM.JobNo) = " & Me.cboJobNo.Value & "
"AND ((tblPartsListing.ManufacturedBy) = 'METRO MACHINE' )) "
End If
Set rs_rsel = CurrentDb.OpenRecordset(sql_rsel)
rs_rsel.MoveLast
y = rs_rsel.RecordCount
With rs_rsel
.MoveFirst
For z = 0 To y - 1
lblCounterStatus.ForeColor = 32768
lblCounterStatus.Caption = "Copying " & z + 1 & " of " & y
FileLocation2 = rs_rsel("PartLocation"
pn = rs_rsel("PartNo"
Debug.Print FileLocation2
Debug.Print pn
If FileLocation2 = "*** FILE NOT FOUND ***" Then
sa = "ALL"
Open "i:\newmanual\_" & Str(Me.cboJobNo.Value) & "_" & sa & "_files_not_found.txt" For Append As #1
Print #1, pn
Close #1
Else
CopyFile FileLocation2, pn
End If
.MoveNext
Next z
End With
End Function
Private Sub CopyFile(ByVal filename As String, ByVal file As String)
If Trim(filename) <> "" Then
'Set objCadApp = GetObject(filename)
Debug.Print filename
FileCopy filename, "i:\newmanual\" + file + ".dwg"
End If
End Sub