Using Recordsets in VB Coding 1

[tstrike]

I am having a problem with on of my recordsets. For some reason Access thinks there are no records in the Recordset, but when I open the query that the recordset is based on there are 4,000 plus records. Here is my Coding.

Option Compare Database
Option Explicit
Dim Msg, Style, Title, Response, stbName, dtbName, FileName, SpecName, TransType
Dim dbType, SFName, DFName, strSQL As String, rst As ADODB.Recordset, jc As String
Dim interval As Integer, stime, CNN As ADODB.Connection

Sub GetDataIntercos()
On Error GoTo Err_GetDataIntercos

Set rst = New ADODB.Recordset
rst.ActiveConnection = CurrentProject.Connection
rst.CursorType = adOpenKeyset
DoCmd.SetWarnings False
'Turns off System Warnings
Call ImportBKPF
'Runs the Programing to Import the BKPF Text File
Call ImportIntercos
'Runs the Programing to Import the Intercos Text File


Exit_GetDataIntercos:
Set rst = Nothing
'Clears the value of rst
DoCmd.SetWarnings True
'Turns on System Warnings
Exit Sub

Err_GetDataIntercos:
MsgBox Err.Description
'Displays the error message
Resume Exit_GetDataIntercos
'Runs the Exit procedures

End Sub
Sub ImportBKPF()
On Error GoTo Err_ImportBKPF

strSQL = "SELECT tblBkpf.* " _
& "FROM TextFileBkpf INNER JOIN tblBkpf ON (TextFileBkpf.DocType = " _
& "tblBkpf.DocType) AND (TextFileBkpf.Year = tblBkpf.Year) AND " _
& "(TextFileBkpf.Docno = tblBkpf.Docno) AND " _
& "(TextFileBkpf.CoCd = tblBkpf.CoCd)"
rst.Open strSQL
'Opens the record set
If AreThereRecords(rst) = True Then
'Tests to see if the text file has already been imported
Msg = "Some or all of the data in C:\temp\BKPF.txt has already been Imported " _
& "to tblBKPF. BKPF.txt will not be imported. Please be sure you " _
& "exported the Correct Period of data from SAP. If you need to replace " _
& "the exsisting data, please delete it from the tblBKPF table and then " _
& "run this program."
'Sets the message to the user
Title = "Data in BKPF.TXT Already exists"
'Sets the Title of the message
Style = vbCritical + vbOKOnly
'Sets the tone and type of message
MsgBox Msg, Style, Title
'Send the message to the user
rst.Close
'Closes the Record Set
GoTo Exit_ImportBKPF
'Exits BKPF Portion of the Get Data
End If
rst.Close
'Closes the Record Set
FileName = "C:\Temp\bkpf.txt"
'Sets the File Name for the Import
SpecName = "Bkpf Import Specification"
'Sets the Specifications for the import
dtbName = "tblbkpf"
'Sets the table to be imported into
DoCmd.TransferText acImportDelim, SpecName, dtbName, FileName, False
'Adds the data in the BKPF Text file to the tblBKPF Table

Exit_ImportBKPF:
Exit Sub

Err_ImportBKPF:
MsgBox Err.Description
'Displays the error message
Resume Exit_ImportBKPF
'Runs the Exit procedures


End Sub

Sub ImportIntercos()
On Error GoTo Err_ImportIntercos

strSQL = "SELECT tblIntercos.* " _
& "FROM TextFileIntercos INNER JOIN tblIntercos ON (TextFileIntercos.Type = " _
& "tblIntercos.Type) AND (TextFileIntercos.Year = tblIntercos.Year) AND " _
& "(TextFileIntercos.Docno = tblIntercos.Docno) AND " _
& "(TextFileIntercos.CoCd = tblIntercos.CoCd)"
rst.Open strSQL
'Opens the record set
If AreThereRecords(rst) = True Then
'Tests to see if the text file has already been imported
Msg = "Some or all of the data in C:\temp\Intercos.txt has already been Imported " _
& "to tblIntercos. Intercos.txt will not be imported. Please be sure you " _
& "exported the Correct Period of data from SAP. If you need to replace " _
& "the exsisting data, please delete it from the tblIntercos table and then " _
& "run this program."
'Sets the message to the user
Title = "Data in Intercos.TXT Already exists"
'Sets the Title of the message
Style = vbCritical + vbOKOnly
'Sets the tone and type of message
MsgBox Msg, Style, Title
'Stores the response from the user
GoTo Exit_ImportIntercos
'Exits Intercos Portion of the Get Data
rst.Close
'Closes the Record Set
End If
rst.Close
'Closes the Record Set
FileName = "C:\Temp\Intercos.txt"
'Sets the File Name for the Import
SpecName = "Intercos Import Specification"
'Sets the Specifications for the import
dtbName = "tblIntercos"
'Sets the table to be imported into
DoCmd.TransferText acImportDelim, SpecName, dtbName, FileName, False
'Adds the Data in the Interco text file to the tblIntercos Table
strSQL = "DELETE tblIntercos.*, tblIntercos.Account " _
& "FROM tblIntercos " _
& "WHERE (((tblIntercos.Account) Is Null))"
DoCmd.RunSQL strSQL
'Deletes the Blank Rows
strSQL = "UPDATE tblBkpf INNER JOIN tblIntercos ON (tblBkpf.CoCd = tblIntercos.CoCd) " _
& "AND (tblBkpf.Year = tblIntercos.Year) AND (tblBkpf.Docno = tblIntercos.Docno) " _
& "AND (tblBkpf.DocType = tblIntercos.Type) " _
& "SET tblIntercos.[Cross-CCnumber] = tblBkpf![Cross-CCnumber] " _
& "WHERE (((tblIntercos.[Cross-CCnumber]) Is Null) AND ((tblIntercos.Cleared)=False))"
DoCmd.RunSQL strSQL
'Adds the Cross Company Doc number to the tblIntercos Table
strSQL = "UPDATE tblBkpf INNER JOIN tblIntercos ON (tblBkpf.Year = tblIntercos.Year) " _
& "AND (tblBkpf.CoCd = tblIntercos.CoCd) AND (tblBkpf.DocType = tblIntercos.Type) " _
& "AND (tblBkpf.Docno = tblIntercos.Docno) AND (tblBkpf.Year = tblIntercos.Year) " _
& "AND (tblBkpf.CoCd = tblIntercos.CoCd) " _
& "SET tblIntercos.Revwith = [tblBkpf]![Revwith] " _
& "WHERE (((tblIntercos.Revwith) Is Null) And ((tblBkpf.Revwith) Is Not Null) " _
& "And ((tblIntercos.Cleared) = False))"
DoCmd.RunSQL strSQL
'Adds Revesed With Doc number to the tblIntercos Table
strSQL = "UPDATE tblBkpf INNER JOIN tblIntercos ON (tblBkpf.Docno = tblIntercos.Revwith) " _
& "AND (tblBkpf.Year = tblIntercos.Year) AND (tblBkpf.CoCd = tblIntercos.CoCd) " _
& "AND (tblBkpf.Year = tblIntercos.Year) AND (tblBkpf.CoCd = tblIntercos.CoCd) " _
& "SET tblIntercos.[Cross-CCnumber] = tblBkpf![Cross-CCnumber] " _
& "WHERE (((tblIntercos.[Cross-CCnumber]) Is Null) AND ((tblIntercos.Cleared)=False))"
DoCmd.RunSQL strSQL
'Adds the Cross Company Doc number to the tblIntercos Table for Reversal Docs
strSQL = "UPDATE tblIntercos SET tblIntercos.IntercoPartner = IIf(IsNull" _
& "(tblIntercos!Vendor),Right(tblIntercos!Customer,4),Right(tblIntercos!Vendor,4)) " _
& "WHERE (((tblIntercos.IntercoPartner) Is Null))"
DoCmd.RunSQL strSQL
'Adds the Interco Partner to the tblIntercos Table
rst.Open "SELECT * FROM qryCrossCompanyDocBal"
'Opens Query as a record set
Do Until rst.EOF
strSQL = "UPDATE tblIntercos SET tblIntercos.Cleared = True " _
& "WHERE(((tblIntercos.[Cross-CCnumber]) = '" & rst("CrossCCnumber") & "'))"
DoCmd.RunSQL strSQL
'Clears the Interco Transactions that have a Zero Balance
rst.MoveNext
'Moves to the next Record
Loop
rst.Close
'Closes Record set
DoCmd.OpenQuery "qryItemswithTextBal"
'Opens Query for Print out
DoCmd.PrintOut
'Prints Query
DoCmd.Close acQuery, "qryItemswithTextBal", acSaveNo
'Closes Query
rst.Open "SELECT * FROM qryItemswithTextBal"
'Opens Query as a record set
Do Until rst.EOF
strSQL = "UPDATE tblIntercos SET tblIntercos.Cleared = True " _
& "WHERE(((tblIntercos.Text) = '" & rst("Text") & "'))"
DoCmd.RunSQL strSQL
'Clears the Items that have Text and a Zero Balance
rst.MoveNext
'Moves to the next Record
Loop
rst.Close
'Closes Record set
DoCmd.OpenQuery "qryPeriodBalances"
'Opens Query for Print out
DoCmd.PrintOut
'Prints Query
DoCmd.Close acQuery, "qryPeriodBalances", acSaveNo
'Closes Query
DoCmd.OpenQuery "qryCurrentBalance"
'Opens Query for Print out
DoCmd.PrintOut
'Prints Query
DoCmd.Close acQuery, "qryCurrentBalance", acSaveNo
'Closes Query
DoCmd.OpenQuery "QryIntercoBalancing"
'Opens Query for Print out
DoCmd.PrintOut
'Prints Query
DoCmd.Close acQuery, "QryIntercoBalancing", acSaveNo
'Closes Query
rst.Open "SELECT * FROM qryDirectPurchInvoices"
'Opens Query as a record set
Do Until rst.EOF
strSQL = "UPDATE tblIntercos SET tblIntercos.Cleared = True " _
& "WHERE(((tblIntercos.Reference) = '" & rst("Reference") & "'))"
DoCmd.RunSQL strSQL
'Clears the KA Doc matches a DP Invoice and a Zero Balance
rst.MoveNext
'Moves to the next Record
Loop
rst.Close
'Closes Record set
DoCmd.OpenQuery "qryUncleared"
'Opens Uncleared Items Query for Review


Exit_ImportIntercos:
Exit Sub

Err_ImportIntercos:
MsgBox Err.Description
'Displays the error message
Resume Exit_ImportIntercos
'Runs the Exit procedures

End Sub
Function AreThereRecords(rstAny As Recordset) As Boolean
AreThereRecords = rstAny.RecordCount
End Function

The part that is causing the problem is this

rst.Open "SELECT * FROM qryDirectPurchInvoices"
'Opens Query as a record set
Do Until rst.EOF
strSQL = "UPDATE tblIntercos SET tblIntercos.Cleared = True " _
& "WHERE(((tblIntercos.Reference) = '" & rst("Reference") & "'))"
DoCmd.RunSQL strSQL
'Clears the KA Doc matches a DP Invoice and a Zero Balance
rst.MoveNext
'Moves to the next Record
Loop
rst.Close
'Closes Record set

All the other Recordset calls are working just fine. I am using Access XP.

Does anyone have any Ideas?

 

[RoyVidar]

Erm - quite a lengthy bit of code to debug...

When using ADO recordset, not all cursortypes support recordcount, here's an article on the subject Why is Recordcount sometimes -1 ?

A more reliable way of testing, is testing for eof and bof:

[tt]if not rs.eof and not rs.bof then
msgbox "There are records..."
end if[/tt]

Roy-Vidar

 

[tstrike]

The problem is that the recordset says there are no records, where the query has 4,000 plus records. I am trying to update recordes based on the record set. I have tried all of the cursortypes, but I get the same responce. Access is saying there are no records in the record set. EOF is true. The other two do loops that I use this method in work just fine.

Any other Ideas?

 

[Orion45]

I think the problem is with your recordset assignments. In your code you create the recordset instance but then a few lines below you set it to nothing before your open statement. Plus, in your open statment you do not specify a connection. Try something like this:
dim rsGetTables as ADODB.recordset

set rsgetTables = new ADODB.recordset
strSQL= "SQL Statement"
rsGetTables.CursorLocation = adUseClient 'Local table
rsGetTables.Open strSQL, CurrentProject.Connection
if rsGetTables.EOF Then
'Do something
End if
'kill the recordset
rsGetTables.close
set rsGetTables = nothing

Hope this helps!

 

[RoyVidar]

Except that the variable names Style and Response, and the field names Year, Type and Text are reserved words and should be avoided as names of fields, controls and variables, and some of the sql contains the bang operator (!) in stead of dot (.), I cant see anything special. For the fields, surround them in [brackets] and see if that helps.

If reposting, try to limit it to the offending routine, marking the recordset...

Roy-Vidar

 

[tstrike]

Roy, I am sory that you found my repost offending. That was not my intent.


When I run this part of the code I get rst.eof = true.

rst.Open "SELECT * FROM qryDirectPurchInvoices"

All the rest of the code works fine. I now have 5900 plus records in the query that the record set is opening. The SQL of the query is this.

SELECT tblIntercos.Reference, Sum(tblIntercos.[Amount in local cur]) AS [SumOfAmount in local cur]
FROM tblIntercos
WHERE (((tblIntercos.Cleared)=False))
GROUP BY tblIntercos.Reference
HAVING (((tblIntercos.Reference) Like "009*") AND ((Sum(tblIntercos.[Amount in local cur]))=0));

I am using the same type of queries for the other rst.open

Why is it only this one that does not work?

 

[Golom]

In this
[blue]
strSQL = "UPDATE tblIntercos SET tblIntercos.Cleared = True " _
& "WHERE(((tblIntercos.Reference) = '" & rst("Reference") & "'))"
[/blue]
you are missing a period. It should be
[tt][blue]
strSQL = "UPDATE tblIntercos SET tblIntercos.Cleared = True " _
& "WHERE(((tblIntercos.Reference) = '" & rst[/blue][COLOR=red yellow].[/color][blue]("Reference") & "'))"
[/blue][/tt]

 

[RoyVidar]

My bad phrasing - I was not offended at all, just trying to make it easier on all of us - you know - looking thru a "mile" of code trying to figure out what the problem might be...;-) Much easier to deal with only the offending code (in the meaning - the code that doesn't perform to expactations - Sorry for the phrasing)

You are sure you have 5900 records where the sum = 0 and reference like '009*'?

Couple of other things to try:

[tt]rst.Open "qryDirectPurchInvoices"[/tt]

I'm not sure how this is evaluated, one usually use * in a stored query, but the ADO wildhcard is %

You could also try to concatintate the whole query into a select statement and run, or try to use the view and ADOX library (I'm not going to take credit for that;-) see cmmrfrds reply here thread701-807150.

Roy-Vidar

 

[tstrike]

I tried
rst.Open "qryDirectPurchInvoices"
and also brining the sql from the query into the code. Neither one works.

rst.eof still = true

I thought by including the hole code, and then showing the problem erea, it would be easier to understand all that is happening. I will try to be more breif next time.

The * what was shown to be used in Alicon Balter's Mastering Access XP book

Golom,

Thank you for the code check. Access told me to do it that way.

 

[RoyVidar]

I'd hoped Golom would enter the thread again, he/she is much better at query stuff than me.

Just did a little test on my setup. When opening the stored query, I got 0 records. When opening thru a select statement, I got the number of records I should. When concatinating the recordset, remember % as wildchards:

[tt]sSql = "SELECT tblIntercos.Reference, " & _
"Sum(tblIntercos.[Amount in local cur]) AS [SumOfAmount in local cur] " & _
"FROM tblIntercos " & _
"WHERE (((tblIntercos.Cleared)=False)) " & _
"GROUP BY tblIntercos.Reference " & _
"HAVING (((tblIntercos.Reference) Like '009%') AND " & _
"((Sum(tblIntercos.[Amount in local cur]))=0));"[/tt]

If this doesn't work, I'm afraid I'm stumped too

Roy-Vidar

 

[tstrike]

Changing the code from rst.Open "qryDirectPurchInvoices" to
strSql = "SELECT tblIntercos.Reference, " & _
"Sum(tblIntercos.[Amount in local cur]) AS [SumOfAmount in local cur] " & _
"FROM tblIntercos " & _
"WHERE (((tblIntercos.Cleared)=False)) " & _
"GROUP BY tblIntercos.Reference " & _
"HAVING (((tblIntercos.Reference) Like '009%') AND " & _
"((Sum(tblIntercos.[Amount in local cur]))=0));"
rst.open strSql

that worked. Thank you Roy for your help.