Error Proofing while Importing Data. 1

[jalge2]

Hey all. We have a database that we use to import text files. The naming convention of the text files are as such:

January 4th, 2005 would be created as 20050104.txt

These files import into a database. The files are created only if there is activity going on, so on Christmas and New Years, there was no Text file created. Is there any way to error proof a database to keep importing if the day is not there? I placed the code of the import, but I am not that strong with Databases and am looking for help. Thanks a lot.

Private Sub IMPORT_New_File_Click()
Dim strPrevDay As String
Dim strYear As String
Dim strDay As String
Dim strMonth As String
Dim strFtpCommand As String
Dim strFileToImport As String
Dim strDateToDelete As String
Dim strLastDateImported As String
Dim strFirstDateImported As String
Dim intRetVal As Integer
Dim strImportFileName As String
Dim strDaysOfHistory As Integer
Dim strLocalFolder As String
Dim strDataFolder As String
Dim strLocalDrive As String
Dim strRemoteIPAddress As String
Dim strFtpUsername As String
Dim strFtpPassword As String
Dim intDayCounter As Integer
Dim strCurrentFileDate As String
Dim strDosCommand As String
Dim modSQL As String
Dim strdate As Date
Dim strAlphaMonth As String
Dim strFirstDate As String
Dim dteDeleteDate As Date
Dim dteLastDate As Date
Dim dteLastTime As Date
Dim dteFirstDate As Date

'----Read in parameters from tblMaster
Set DB = CurrentDb
Set vrecset = DB.OpenRecordset("tblMaster")
With vrecset
If (Not .BOF Or Not .EOF) Then
.MoveFirst
strDaysOfHistory = vrecset("NumberOfDaysHistory")
strLocalFolder = vrecset("DbFolder")
strDataFolder = vrecset("DataFolder")
strLocalDrive = vrecset("localdrive")
strRemoteIPAddress = vrecset("remoteIPaddress")
strFtpUsername = vrecset("ftpusername")
strFtpPassword = vrecset("ftppassword")
End If
End With
vrecset.Close
DB.Close

'----Determine and format the previous days filename
txtboxImportStatus.SetFocus
txtboxImportStatus = "Checking for previous days records...Please wait"
strPrevDay = DateAdd("d", -1, Now())
strYear = DatePart("yyyy", strPrevDay)
strDay = DatePart("d", strPrevDay)
strMonth = DatePart("m", strPrevDay)

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strFileToImport = strYear + strMonth + strDay
strCurrentFileDate = strFileToImport

'Check to see if tblFilesImported table is current with yesterdays data
Set DB = CurrentDb
Set vrecset = DB.OpenRecordset("tblFilesImported")
With vrecset
If (Not .BOF Or Not .EOF) Then
.MoveLast
strLastDateImported = vrecset("filename")
End If
End With
vrecset.Close
DB.Close

'If tblFilesImported current up until yesterday, import any data from today
txtboxImportStatus.SetFocus
txtboxImportStatus = "Importing todays records...Please wait"
If strLastDateImported = strFileToImport Then
'Delete any existing data with todays date.
strYear = DatePart("yyyy", Now())
strDay = DatePart("d", Now())
strMonth = DatePart("m", Now())

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strFileToImport = strYear + strMonth + strDay
strCurrentFileDate = strFileToImport
strAlphaMonth = NumericMonthToAlpha(strMonth)
strdate = Date
Set DB = CurrentDb()
modSQL = "DELETE tblPutData.*, tblPutData.Date " _
& "FROM tblPutData " _
& "WHERE tblPutData.Date= #" & strdate & "#;"
DB.Execute modSQL

strImportFileName = strLocalDrive + strDataFolder + "\" + strFileToImport + ".txt"
DoCmd.TransferText acImportFixed, "PutImportSpec", "tblPutData", strImportFileName
On Error GoTo 0

'Check to see if tblFilesImported table is current with yesterdays data
Set DB = CurrentDb
Set vrecset = DB.OpenRecordset("tblFilesImported")
With vrecset
If (Not .BOF Or Not .EOF) Then
.MoveFirst
strFirstDate = vrecset("filename")
End If
End With
vrecset.Close
DB.Close

'Get First and last dates to display in text box.
Set DB = CurrentDb
Set vqdf = DB.CreateQueryDef("", "SELECT tblPutData.Date, tblPutData.Time " _
& " FROM tblPutData " _
& " ORDER BY tblPutData.Date DESC , tblPutData.Time DESC; ")
With vqdf
Set vrecset = vqdf.OpenRecordset
With vrecset
If (Not .BOF Or Not .EOF) Then
.MoveFirst
dteLastDate = vrecset("Date")
dteLastTime = vrecset("Time")
.MoveLast
dteFirstDate = vrecset("Date")
End If
End With
End With
vrecset.Close
DB.Close

'----- Get oldest date for textbox display purposes
txtboxImportStatus.SetFocus
txtboxImportStatus = "Data Current for dates " & dteFirstDate & " thru " & dteLastDate & " " & dteLastTime
CheckForLargeQty
Exit Sub
End If

'We got to here so there must be some data to import, determine which dates to import
txtboxImportStatus.SetFocus
txtboxImportStatus = "Importing previous days records...Please wait"
intDayCounter = -14
strPrevDay = DateAdd("d", intDayCounter, Now())
strYear = DatePart("yyyy", strPrevDay)
strDay = DatePart("d", strPrevDay)
strMonth = DatePart("m", strPrevDay)

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strFileToImport = strYear + strMonth + strDay

While strLastDateImported >= strFileToImport
intDayCounter = intDayCounter + 1
strPrevDay = DateAdd("d", intDayCounter, Now())
strYear = DatePart("yyyy", strPrevDay)
strDay = DatePart("d", strPrevDay)
strMonth = DatePart("m", strPrevDay)

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strFileToImport = strYear + strMonth + strDay
Wend

While strFileToImport <= strCurrentFileDate
strImportFileName = strLocalDrive + strDataFolder + "\" + strFileToImport + ".txt"
DoCmd.TransferText acImportFixed, "PutImportSpec", "tblPutData", strImportFileName
On Error GoTo 0

'Update tblFilesImported
Set DB = CurrentDb
Set vrecset = DB.OpenRecordset("tblFilesImported")
With vrecset
If (Not .BOF Or Not .EOF) Then
.AddNew
![filename] = strYear + strMonth + strDay
.Update
End If
End With
vrecset.Close
DB.Close

'Get next file to import
intDayCounter = intDayCounter + 1
strPrevDay = DateAdd("d", intDayCounter, Now())
strYear = DatePart("yyyy", strPrevDay)
strDay = DatePart("d", strPrevDay)
strMonth = DatePart("m", strPrevDay)

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strFileToImport = strYear + strMonth + strDay
Wend


'---- Remove data from tblPutData and tblFilesImported over 14 days old.
txtboxImportStatus.SetFocus
txtboxImportStatus = "Removing records older than " & strDaysOfHistory & " days...Please wait"
strPrevDay = DateAdd("d", -15, Now())
dteDeleteDate = DateAdd("d", -15, Now())
strYear = DatePart("yyyy", strPrevDay)
strDay = DatePart("d", strPrevDay)
strMonth = DatePart("m", strPrevDay)

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strDateToDelete = strYear + strMonth + strDay

'Get the oldest date from tblFilesImported
Set DB = CurrentDb
Set vrecset = DB.OpenRecordset("tblFilesImported")
With vrecset
If (Not .BOF Or Not .EOF) Then
.MoveFirst
strFirstDateImported = vrecset("filename")
End If
End With
vrecset.Close
DB.Close

strYear = DatePart("yyyy", dteDeleteDate)
strDay = DatePart("d", dteDeleteDate)
strMonth = DatePart("m", dteDeleteDate)
strdate = strMonth + "/" + strDay + "/" + strYear
While strFirstDateImported <= strDateToDelete
strAlphaMonth = NumericMonthToAlpha(strMonth)
Set DB = CurrentDb()
modSQL = "DELETE tblPutData.*, tblPutData.Date " _
& "FROM tblPutData " _
& "WHERE tblPutData.Date=#" & strdate & "#;"
DB.Execute modSQL

'----Remove entry from tblFilesImported
modSQL = "DELETE tblFilesImported.*, tblFilesImported.filename " _
& "FROM tblFilesImported " _
& "WHERE tblFilesImported.filename='" & strDateToDelete & "';"
DB.Execute modSQL

strPrevDay = DateAdd("d", -1, strPrevDay)
dteDeleteDate = DateAdd("d", -1, strPrevDay)
strYear = DatePart("yyyy", strPrevDay)
strDay = DatePart("d", strPrevDay)
strMonth = DatePart("m", strPrevDay)

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strDateToDelete = strYear + strMonth + strDay
strdate = strMonth + "/" + strDay + "/" + strYear
Wend


'----Remove any existing data for current day the import current days information
txtboxImportStatus.SetFocus
txtboxImportStatus = "Importing todays records...Please wait"
strYear = DatePart("yyyy", Now())
strDay = DatePart("d", Now())
strMonth = DatePart("m", Now())

'Check for two digit month or day
If Len(strMonth) = 1 Then strMonth = "0" + strMonth
If Len(strDay) = 1 Then strDay = "0" + strDay
strFileToImport = strYear + strMonth + strDay
strCurrentFileDate = strFileToImport

strAlphaMonth = NumericMonthToAlpha(strMonth)
strdate = Date
Set DB = CurrentDb()
modSQL = "DELETE tblPutData.*, tblPutData.Date " _
& "FROM tblPutData " _
& "WHERE tblPutData.Date= #" & strdate & "#;"
DB.Execute modSQL

'On Error GoTo WaitForTransfer
strImportFileName = strLocalDrive + strDataFolder + "\" + strFileToImport + ".txt"
DoCmd.TransferText acImportFixed, "PutImportSpec", "tblPutData", strImportFileName
On Error GoTo 0


'Get First and last dates for display in text box.
Set DB = CurrentDb
Set vqdf = DB.CreateQueryDef("", "SELECT tblPutData.Date, tblPutData.Time " _
& " FROM tblPutData " _
& " ORDER BY tblPutData.Date DESC , tblPutData.Time DESC; ")
With vqdf
Set vrecset = vqdf.OpenRecordset
With vrecset
If (Not .BOF Or Not .EOF) Then
.MoveFirst
dteLastDate = vrecset("Date")
dteLastTime = vrecset("Time")
.MoveLast
dteFirstDate = vrecset("Date")
End If
End With
End With
vrecset.Close
DB.Close

txtboxImportStatus.SetFocus
txtboxImportStatus = "Data Current for dates " & dteFirstDate & " thru " & dteLastDate & " " & dteLastTime
CheckForLargeQty
'Handle error when file transfer not finished
Exit Sub
WaitForTransfer:
Wait (3)
Resume

End Sub

Jason Alge
Jason.M.Alge@lowes.com

'There are three kinds of people: Those who can count and those who can't'

 

[DrSimon]

That's a lot of code to go through so I haven't done so in detail.
What I think you should do is add something like the following after each line where strImportFileName is set.

If Dir(strImportFileName)<>"" Then .....
.... Code that processes that file
End If

So if the file doesn't exist, the code won't try to process it.

Simon Rouse

 

[jalge2]

Thanks for the help. I put what you gave me into the module in two places. I tried to run the code, but still received the error saying that it couldn't find file 20040105.txt (which I took out for test purposes). Here is what the code looks like in those two places.

If Dir(strImportFileName) <> "" Then
strImportFileName = strLocalDrive + strDataFolder + "\" + strFileToImport + ".txt"
DoCmd.TransferText acImportFixed, "PutImportSpec", "tblPutData", strImportFileName
End If


While strFileToImport <= strCurrentFileDate
If Dir(strImportFileName) <> "" Then
strImportFileName = strLocalDrive + strDataFolder + "\" + strFileToImport + ".txt"
DoCmd.TransferText acImportFixed, "PutImportSpec", "tblPutData", strImportFileName
End If

Plus when I drag my mouse over the strImportFileName, the yellow box comes up and give me the location of the file. G:\\Prorep\Kronos\20050105.txt.

Thanks for any help you can give.

Jason Alge
Jason.M.Alge@lowes.com

'There are three kinds of people: Those who can count and those who can't'

 

[DrSimon]

Not quite Jason, you seem to have misunderstood. Dir() checks if the file is there. Try this for example

strImportFileName = strLocalDrive + strDataFolder + "\" + strFileToImport + ".txt"
If Dir(strImportFileName) <> "" Then
        DoCmd.TransferText acImportFixed, "PutImportSpec", "tblPutData", strImportFileName
End If

 

[jalge2]

That worked Dr.Simon. Thanks a lot for the help. Have a star.

By the way, misunderstanding is my trademark.

Thanks again.

Jason Alge
Jason.M.Alge@lowes.com

'There are three kinds of people: Those who can count and those who can't'