Public Sub Read864()
'---------------------------------------
'Read 864 -
'3/10/2003 -
'Tyrone Lumley -
'Loops through a list of raw documents -
'And populates a store table with the -
'Results -
'---------------------------------------
On err goto err_hand
Dim rstRaw As New ADODB.Recordset ' Table with list of raw document names
Dim rst864 As New ADODB.Recordset 'Table to add JCP Stores to
Dim strDocument As String 'Document name
Dim strDir As String 'Directory
Dim strDelimiter As String 'Delimeter
Dim strReason As String 'reason 01, 02 or 05 not used yet
Dim strAddress As String 'Address
Dim strCity As String ' City
Dim strState As String ' State
Dim strZip As String 'Zip
Dim strStoreName As String ' Store name (not always there)
rstRaw.Open "qselNewStoreList", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
rst864.Open "tblJCPStores", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
strDir = "\\dellserver\Users\Public\782002\GEDesktop 624 On\" 'Changfe this as required
strDelimiter = "" 'Delimiter
rstRaw.MoveLast 'Move first and last to get record count
rstRaw.MoveFirst
Do While Not rstRaw.EOF
strDocument = strDir & rstRaw.Fields(3) 'full path and file name
Open strDocument For Input As #1 'open the document
Do While Not EOF(1)
Input #1, myString 'line of text in document
myarray = Split(myString, strDelimiter) 'split into an arrary
Select Case myarray(0)
Case "BMG"
strReason = myarray(3)
Case "N1"
strStore = myarray(4)
Case "N3"
If UBound(myarray) = 2 Then
strStoreName = myarray(1)
strAddress = myarray(2)
Else
strAddress = myarray(1)
End If
Case "N4"
strCity = myarray(1)
strState = myarray(2)
strZip = myarray(3)
End Select
Loop
Close #1
With rst864
.AddNew
.Fields(0) = strReason
.Fields(1) = strStore
.Fields(2) = strStoreName
.Fields(3) = strAddress
.Fields(4) = strCity
.Fields(5) = strState
.Fields(6) = strZip
.Update
End With
strStoreName = ""
rstRaw.MoveNext
Loop
End Sub
err_hand:
debug.print err.num err.desc
. it seems like they actually have a strategist to "legally' impose chargebacks on their partners.