0
HI SQL數據庫，分配記錄使用VB6
我已經創造了VB6記錄和存儲，我從TXT文件中讀取值。當iam試圖執行將我的記錄集數據插入數據庫表的sql查詢。我得到的錯誤如
'''EOF或BOF是真實的，或者當前重新校正已被刪除。請求的操作需要當前記錄。 「」」
我只是附上我的代碼，任何人都可以請幫我在哪裏做錯了。我相信這是錯誤的prasing個人名字。但我不知道它是什麼。
任何幫助將是讚賞。
Public Function ProcessDNE(ByVal strFileName As String) As Boolean
Dim intFileNbr As Integer
Dim strCurrentLine As String
Dim strRoutingNbr As String
Dim strAcct As String
Dim strIndividualName As String
Dim strAmount As String
Dim curAmount As Currency
Dim strParseString As String
Dim strParseFirstNm As String
Dim strParseMidInit As String
Dim strParseLastNam As String
Dim lngMidInitPos As Long
Dim lngParsePos1 As Long
Dim lngParsePos2 As Long
Dim lngParsePos3 As Long
Dim lngParsePos4 As Long
Dim lngParsePos5 As Long
Dim lngParsePos6 As Long
Dim lngPos As Long
frmDNELoad.lblStatus.Caption = "Reading File..."
frmDNELoad.Refresh
'' # Set up rcdDNE structure
With rcdDNE.Fields
.Append "RTN", adVarChar, 9
.Append "AccountNbr", adVarChar, 17
.Append "IndividualName", adVarChar, 22
.Append "FirstName", adVarChar, 50
.Append "MiddleName", adVarChar, 1
.Append "LastName", adVarChar, 50
.Append "Amount", adCurrency
End With
rcdDNE.Open
intFileNbr = FreeFile(1)
Open strFileName For Input As #intFileNbr Len = 95 '' # Open file for input.
Do While Not EOF(intFileNbr)
Line Input #intFileNbr, strCurrentLine
If Mid(strCurrentLine, 1, 1) = 6 Then
strRoutingNbr = Mid(strCurrentLine, 4, 8)
strAcct = Trim(Mid(strCurrentLine, 13, 17))
strIndividualName = Trim(Mid(strCurrentLine, 55, 22))
strAmount = Trim(Mid(strCurrentLine, 30, 10))
strAmount = Left(strAmount, Len(strAmount) - 1)
curAmount = CCur(strAmount)
'' # Add new record to temporary recordset
With rcdDNE
.AddNew
.Fields![RTN] = strRoutingNbr
.Fields![AccountNbr] = strAcct
.Fields![IndividualName] = strIndividualName
.Fields![Amount] = curAmount
.Update
End With
End If
Loop
Close #intFileNbr
frmDNELoad.lblStatus.Caption = "Formatting Names..."
frmDNELoad.Refresh
DoEvents
'' # Parse the IndividualName field
rcdDNE.MoveFirst
Do Until rcdDNE.EOF
lngMidInitPos = 0
lngParsePos1 = 0
lngParsePos2 = 0
lngParsePos3 = 0
lngParsePos4 = 0
lngParsePos5 = 0
lngParsePos6 = 0
strParseString = ""
strParseFirstNm = ""
strParseMidInit = ""
strParseLastNam = ""
strParseString = Trim(rcdDNE.Fields![IndividualName])
'' # Replace double spaces (" ") with a single space (" ")
lngPos = InStr(1, strParseString, " ")
Do While lngPos
strParseString = Mid(strParseString, 1, lngPos - 1) & Mid(strParseString, lngPos + 1, Len(strParseString))
lngPos = InStr(1, strParseString, " ")
Loop
'' # Locate positions of remaining spaces
lngParsePos1 = InStr(1, strParseString, " ")
If lngParsePos1 = 0 Then
lngParsePos2 = 0
Else
lngParsePos2 = InStr(lngParsePos1 + 1, strParseString, " ")
End If
If lngParsePos2 = 0 Then
lngParsePos3 = 0
Else
lngParsePos3 = InStr(lngParsePos2 + 1, strParseString, " ")
End If
If lngParsePos3 = 0 Then
lngParsePos4 = 0
Else
lngParsePos4 = InStr(lngParsePos3 + 1, strParseString, " ")
End If
If lngParsePos4 = 0 Then
lngParsePos5 = 0
Else
lngParsePos5 = InStr(lngParsePos4 + 1, strParseString, " ")
End If
If lngParsePos5 = 0 Then
lngParsePos6 = 0
Else
lngParsePos6 = InStr(lngParsePos5 + 1, strParseString, " ")
End If
'' # Determine if Middle initial is present
If (lngParsePos3 - lngParsePos2) = 2 Then
lngMidInitPos = lngParsePos2 + 1
rcdDNE.Fields![MiddleName] = Mid(strParseString, lngMidInitPos, 1)
ElseIf (lngParsePos4 - lngParsePos3) = 2 Then
lngMidInitPos = lngParsePos3 + 1
rcdDNE.Fields![MiddleName] = Mid(strParseString, lngMidInitPos, 1)
ElseIf (lngParsePos5 - lngParsePos4) = 2 Then
lngMidInitPos = lngParsePos4 + 1
rcdDNE.Fields![MiddleName] = Mid(strParseString, lngMidInitPos, 1)
ElseIf (lngParsePos6 - lngParsePos5) = 2 Then
lngMidInitPos = lngParsePos5 + 1
rcdDNE.Fields![MiddleName] = Mid(strParseString, lngMidInitPos, 1)
ElseIf (lngParsePos2 - lngParsePos1) = 2 Then
lngMidInitPos = lngParsePos1 + 1
rcdDNE.Fields![MiddleName] = Mid(strParseString, lngMidInitPos, 1)
End If
'' # If there is a middle initial, everything to the left of it goes into the
'' # first name field, and everything to the right of it goes into the last
'' # name field. If there is no middle initial, everything after the first space
'' # goes into the last name field.
If lngMidInitPos <> 0 Then
rcdDNE.Fields![FirstName] = Trim(Left(strParseString, lngMidInitPos - 1))
rcdDNE.Fields![LastName] = Trim(Mid(strParseString, lngMidInitPos + 1, Len(strParseString)))
Else
rcdDNE.Fields![FirstName] = Trim(Left(strParseString, lngParsePos1))
rcdDNE.Fields![LastName] = Trim(Mid(strParseString, lngParsePos1 + 1, Len(strParseString)))
End If
rcdDNE.Update
rcdDNE.MoveNext
Loop
'' # Write records to Database
frmDNELoad.lblStatus.Caption = "Loading data into database......"
Call FindServerConnection_NoMsg
'' # Do Until rcdDNE.EOF
'' # rcdDNE.MoveFirst
'' # cmdCommand.CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
'' # cmdCommand.Execute()
'' # rcdDNE.MoveNext
'' # Loop
Dim lngRecCount As Long
lngRecCount = 0
Set rcdReclamation = New ADODB.Recordset
With rcdReclamation
.ActiveConnection = objConn
.Source = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open , , , , adCmdStoredProc
End With
rcdDNE.MoveFirst
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh
End Function
VB6應該默認告訴你哪一行錯誤正在發生 - 哪一個是它？ – MartW 2009-11-27 17:27:13