Log in

View Full Version : Loop not working?



samuelimtech
07-13-2015, 03:33 AM
Hi all,

I have a code that loops through files in a folder and imports them.
I had this working in a very simple form then I decided to add in checks to see if it exists it certain places and if it does do something different. anyway all the checks seem to work (don't laugh theres probably more efficient ways of doing it) but for some reason now the code wont loop through the files. the MyFile variable sticks on the first value it receives and doesn't move onto the next.

thanks for any help.


MyFile = Dir(MyPath)
Do While MyFile <> ""

WeekNo = Left(MyFile, 2)
StaffJDE = Mid(MyFile, 4, 6)
' DirFile = "\\uksv0015\shared\Timesheet (file://\\uksv0015\shared\Timesheet) process\Archive\Timesheets\" & WeekNo & "\" & MyFile
If Dir("\\uksv0015\shared\Timesheet (file://\\uksv0015\shared\Timesheet) process\Archive\Timesheets\" & WeekNo & "\" & MyFile) = "" Then ' If File Does not exist then import

If MyFile Like "*.xlsx" Then

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Import Table", _
MyPath & MyFile, _
True, "Database!A:Q"
FSO.movefile DownloadFolder & MyFile, "\\uksv0015\shared\Timesheet (file://\\uksv0015\shared\Timesheet) process\Archive\Timesheets\" & WeekNo & "\" & MyFile & MyFile
End If

Else
'If it already exists go find it
Dim TimesheetsPath
TimesheetsPath = DLookup("[Definition]", "Config", "[Parameter]='Archive'") & "\Timesheets\" & WeekNo & "\"


'check Import
If DCount("[ID]", "Import Table", "[Employee Number] ='" & StaffJDE & "'And [Week No] ='" & WeekNo & "'") > 0 Then
DELETEstrSQL = "DELETE * FROM [Import Table] WHERE [Import Table].[Employee Number] = '" & StaffJDE & "' AND [Import Table].[Week No] = " & WeekNo & " ;"
'Delete from Import and move both to review
DoCmd.RunSQL DELETEstrSQL
k = FSO.GetFolder(ReviewFolder).Files.count
FSO.movefile TimesheetsPath & myItem.Attachments.Item(i).FileName, ReviewFolder & Replace(myItem.Attachments.Item(i).FileName, ".xlsx", "-" & k & " .xlsx")
FSO.movefile DownloadFolder & myItem.Attachments.Item(i).FileName, ReviewFolder & Replace(myItem.Attachments.Item(i).FileName, ".xlsx", "-" & k & " .xlsx")
End If


'Check Export
If DCount("[ID]", "Export Table", "[Employee Number] ='" & StaffJDE & "'And [Week No] ='" & WeekNo & "'") > 0 Then
DELETEstrSQL = "DELETE * FROM [Export Table] WHERE [Import Table].[Employee Number] = '" & StaffJDE & "' AND [Import Table].[Week No] = " & WeekNo & " ;"
'Delete from Export and move both to review
DoCmd.RunSQL DELETEstrSQL
k = FSO.GetFolder(ReviewFolder).Files.count
FSO.movefile TimesheetsPath & myItem.Attachments.Item(i).FileName, ReviewFolder & Replace(myItem.Attachments.Item(i).FileName, ".xlsx", "-" & k & " .xlsx")
FSO.movefile DownloadFolder & myItem.Attachments.Item(i).FileName, ReviewFolder & Replace(myItem.Attachments.Item(i).FileName, ".xlsx", "-" & k & " .xlsx")
End If



If DCount("[ID]", "Archive", "[Employee Number] ='" & StaffJDE & "'And [Week No] ='" & WeekNo & "'") > 0 Then
FSO.movefile DownloadFolder & MyFile, ReviewFolder & MyFile
'ask what Heidi wants to do.
End If



End If
MyFile = Dir
Loop
[/CODE]

jonh
07-13-2015, 02:00 PM
Whenever you give a path to the dir function, that is the path that calling dir without a path will use.

The IF you've written to check if the file exists is cancelling out your initial use of dir.