Here you go. Thanks.
Option Compare Database
Option Explicit
Public Const cIncomingReturns As String = "C:\Documents and Settings\carpean\My Documents\Returns Month End\Incoming Returns.MBK.txt"
'Public Const cIncomingReturns As String = "c:\Test\Test.txt"
Public Const cTITLE2 As String = "Incoming Returns"
Sub ImportFile()
'Requires CommDlg Class Module.
Dim myCheck
Dim dbs As DAO.Database, rst As DAO.Recordset
Dim strInFile As String, intInFile As Integer, strFileData As String, cd As CommDlg
Dim datReport As Date
Dim strDate As Date
Dim strDeposit As String
Dim strLocation As String
Dim strAlt As String
Dim strCustomerName As String
Dim strAmt As String
Dim strSite As String
Dim strSeqNum As String
Dim strQueue As String
Dim strType As String
Dim strRedeposit As String
Dim strDepDate As String
Dim strHSSeq As String
Dim strCreditHS As String
Dim strUser As String
Dim strMemo As String
Dim strReason As String
Dim strMICRSerial As String
Dim strMICRRT As String
Dim strMICRAcctNumber As String
Dim strMICRDEPRoute As String
Dim strMICRDep As String
Dim strDepAmt As String
Dim strSource As String
On Error GoTo ImportFile_Err
'locate data source file
strInFile = cIncomingReturns
DoEvents 'Let Windows repaint the screen.
myCheck = MsgBox("Are you sure you want to import Incoming Returns Text File?", vbYesNo)
If myCheck = vbYes Then
' your import code here
'Initialize DAO objects.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tbl_IncomingReturns", dbOpenDynaset)
'Assign file number and open file.
intInFile = FreeFile
Open strInFile For Input As intInFile
SysCmd acSysCmdInitMeter, "Importing Data File", LOF(intInFile)
'Read file into the database.
Do Until EOF(intInFile)
SysCmd acSysCmdUpdateMeter, (Loc(intInFile) * 128)
Line Input #intInFile, strFileData 'read line.
'get report date
If StrComp(Mid(strFileData, 2, 4), "DATE", vbBinaryCompare) = 0 Then
datReport = Mid(strFileData, 8, 10)
strDate = datReport
End If
'gets the additional dates in the combined file
If StrComp(Mid(strFileData, 3, 4), "DATE", vbBinaryCompare) = 0 Then
datReport = Mid(strFileData, 9, 10)
strDate = datReport
Line Input #intInFile, strFileData
End If
'get the deposit acct
If StrComp(Mid(strFileData, 1, 10), "Depositing", vbBinaryCompare) = 0 Then
strDeposit = Mid(strFileData, 32, 13)
strLocation = Mid(strFileData, 46, 20)
End If
'get the alternate acct
'If StrComp(Mid(strFileData, 1, 9), "Alternate", vbBinaryCompare) = 0 Then
'strAlt = Mid(strFileData, 31, 14)
'End If
'get the alternate acct
If StrComp(Mid(strFileData, 1, 9), "Alternate", vbBinaryCompare) = 0 Then
strAlt = Mid(strFileData, 31, 14)
'Read another line of your text file
'strCustomerName = Mid(strFileData, 1, 43)
End If
'get Customer Name
'If InStr("Alternate", vbCrLf) Then
'strCustomerName = Mid(strFileData, 1, 43)
'End If
'get the item amount, site, TRIPS sequence number, receive type, and redeposit indicator
If StrComp(Mid(strFileData, 1, 4), "Item", vbBinaryCompare) = 0 Then
strAmt = Mid(strFileData, 14, 16)
strSite = Mid(strFileData, 39, 1)
strSeqNum = Mid(strFileData, 46, 7)
strQueue = Mid(strFileData, 62, 2)
strSource = Mid(strFileData, 112, 6)
strType = Mid(strFileData, 125, 6)
strRedeposit = Mid(strFileData, 30, 2)
End If
'get deposit date, high speed sequence number, and deposit sequence number
If StrComp(Mid(strFileData, 1, 13), "Deposit Date:", vbBinaryCompare) = 0 Then
If Trim(Mid(strFileData, 15, 10)) <> "00/00/0000" Then
strDepDate = Mid(strFileData, 15, 10)
Else
strDepDate = "11/11/1111"
End If
strHSSeq = Mid(strFileData, 49, 10)
strCreditHS = Mid(strFileData, 83, 10)
End If
'get user ID and hold status
If StrComp(Mid(strFileData, 1, 12), "Processed By", vbBinaryCompare) = 0 Then
strUser = Mid(strFileData, 16, 7)
strMemo = Mid(strFileData, 116, 8)
End If
'get return reason
If StrComp(Mid(strFileData, 1, 6), "Reason", vbBinaryCompare) = 0 Then
strReason = Mid(strFileData, 14, 23)
End If
'Get MICR Serial #, Account #, and Routing Number
If StrComp(Mid(strFileData, 1, 12), "Capture MICR", vbBinaryCompare) = 0 Then
If Trim(Mid(strFileData, 30, 10)) <> "" Then
strMICRSerial = Mid(strFileData, 30, 10)
Else
strMICRSerial = "0"
End If
If Trim(Mid(strFileData, 56, 9)) <> "" Then
strMICRRT = Mid(strFileData, 56, 9)
Else
strMICRRT = "0"
End If
If Trim(Mid(strFileData, 78, 15)) <> "" Then
strMICRAcctNumber = Mid(strFileData, 78, 15)
Else
strMICRAcctNumber = "0"
End If
End If
'Get original Credit MICR account and deposit amount
If StrComp(Mid(strFileData, 1, 8), "Credit ", vbBinaryCompare) = 0 Then
If Trim(Mid(strFileData, 56, 9)) <> "" Then
strMICRDEPRoute = Mid(strFileData, 56, 9)
Else
strMICRDEPRoute = "0"
End If
If Trim(Mid(strFileData, 80, 13)) <> "" Then
strMICRDep = Mid(strFileData, 80, 13)
Else
strMICRDep = "0"
End If
If Trim(Mid(strFileData, 110, 12)) <> "" Then
strDepAmt = Mid(strFileData, 110, 12)
Else
strDepAmt = "0"
End If
'This is an alternative statement that can be used
'when there is no line feed or carriage return characters in the file.
'Typically you will have to add 1 to the record length (110 in this case)
'to make this work.
'strFileData = Input$(111, #intInFile)
'updates the table
With rst
.AddNew
!Date = strDate
!DepAC = strDeposit
!Location = strLocation
!ChgbackAC = strAlt
!CustomerName = strCustomerName
!Amount = strAmt
!Site = strSite
!TRIPSSeqNumber = strSeqNum
!Queue = strQueue
!Type = strType
!Redeposit = strRedeposit
!DepDate = strDepDate
!HSSeqNumber = strHSSeq
!CreditHSSeqNumber = strCreditHS
!UserID = strUser
!MemoPostODStatus = strMemo
!RtnReason = strReason
!MICRSerial = strMICRSerial
!MICRRT = strMICRRT
!MICRAcctNumber = strMICRAcctNumber
!MICRDEPRoute = strMICRDEPRoute
!MICRDep = strMICRDep
!DepAmt = strDepAmt
!Source = strSource
.Update
End With
End If
Loop
Else
MsgBox "Incoming Returns Import cancelled", vbOKOnly
End If
rst.Close
dbs.Close
MsgBox "Incoming Returns File Import Complete."
ImportFile_Exit:
SysCmd acSysCmdClearStatus
Close intInFile
Set dbs = Nothing
Set rst = Nothing
Set cd = Nothing
Exit Sub
ImportFile_Err:
'MsgBox Err & " " & Err.Description & vbLf & "Job Name: ImportFile" & vbLf & cSUPPORT, vbCritical
Resume ImportFile_Exit
End Sub
