|
| The following code used to work fine, now it does damn all.
It fails (as in does nothing at the .execute stage)
Can any of you see the obvious?
'#######################################
#
Public Sub sListPRTXTFiles()
Dim varItem As Variant, intStrLenToRemove, intStrLen As Integer, dbsA As
Database
Set dbsA = CurrentDb()
Set rstTgt = dbsA.OpenRecordset("tblPRFX_FILE")
'###########################
DoCmd.SetWarnings False
strSQL = "UPDATE tblPRFX_FILE SET tblPRFX_FILE.REPLACE = 0"
DoCmd.RunSQL strSQL
strSQL = "UPDATE tblPRFX_FILE SET tblPRFX_FILE.ToBeDumped = 0"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'############################
rstTgt.Index = "PrimaryKey"
'# path hard coded.......change to lookup location in file import table
strPath = "C:\TestDATA\PRFX\"
'###############################
intStrLenToRemove = Len(strPath)
Stop
With Application.FileSearch
.NewSearch
.FileName = "PR*.TXT"
.LookIn = strPath
.Execute
For Each varItem In .FoundFiles
intStrLen = Len(varItem)
strFlNm = Right(varItem, (intStrLen - intStrLenToRemove))
If strFlNm = "prfx0309" Then Stop
Debug.Print strFlNm
rstTgt.S "=", Trim(Left(strFlNm, 8))
If rstTgt.NoMatch Then
rstTgt.AddNew
rstTgt![File] = Trim(Left(strFlNm, 8))
strFile = varItem
rstTgt![FoundFileDateAndTime] =
dhGetFileTimesExNAB(strFile)
rstTgt.Update
Else
rstTgt.EDIT
strFile = varItem
rstTgt![FoundFileDateAndTime] =
dhGetFileTimesExNAB(strFile)
'rstTgt![LoadedFileDateAndTime] =
dhGetFileTimesExNAB(strFile)
'rstTgt![Replace] = 0
If dhGetFileTimesExNAB(strFile) <>
rstTgt![LoadedFileDateAndTime] Then rstTgt![Replace] = -1
rstTgt.Update
End If
Next varItem
End With
DBEngine.Idle dbRefreshCache
Set rstTgt = Nothing
dbsA.Close
Debug.Print " Listed Found PRtx files"
End Sub
|
|