[AccessD] Record Count Problem

Thanx Max. 


Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com
www.bchacc.com
 
 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Max Wanadoo
Sent: Wednesday, February 18, 2009 9:56 AM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] Record Count Problem

Hi Rocky,
Hope these two examples help.  Ignore the rubbish coding...
You can also position directly onto the rst as shown in vers 2.
Max

Public Property Get AddNewLocationFromForm(frm As Form) As Long ' Adds a new
location based on the data entered into the form
  On Error GoTo errhandler
  Dim lngLocationID As Long, lngMailsortAID As Long
  sqlGeoMailsortA = "SELECT * From mcmGeoMailsortA Where MailsortAID=" &
frm!FKMailsortAIDx
  Set rstGeoMailsortA = dbs.OpenRecordset(sqlGeoMailsortA)
  If rstGeoMailsortA.EOF Then
    MsgBox "I cannot find this PostalCode"
    GoTo exithere
  Else
    lngMailsortAID = rstGeoMailsortA!MailsortAID
  End If

  sqlLocation = "SELECT * From mcmGeoLocations Where " & _
                "FKCountryID = " & Nz(frm!FKCountryIDx, 617) & _
              " AND OverseasPostCode = " & conQuote &
Nz(frm!OverseasPostCodex, "") & conQuote
  Set rstLocation = dbs.OpenRecordset(sqlLocation)

  If rstLocation.EOF Then
    lngLocationID = 0
    rstLocation.AddNew
    rstLocation!FKCountryID = Nz(frm!FKCountryIDx, 617)
    rstLocation!OverseasPostCode = Nz(frm!OverseasPostCodex, "")
    rstLocation!LastUser = "System"
    rstLocation!LastEdited = Date
    rstLocation!CreatedBy = "System"
    rstLocation!CreateDate = Date
    rstLocation.Update
    rstLocation.Move 0, rstLocation.LastModified
    lngLocationID = rstLocation!LocationID
  Else
    lngLocationID = rstLocation!LocationID
  End If
exithere:
  If lngLocationID = 0 Then
    MsgBox "This Location cannot be added"
  Else
    MsgBox "Location has been added/already present (" & lngLocationID & ")"
  End If
  AddNewLocationFromForm = lngLocationID
  Exit Property
errhandler:
  Select Case Err.Number
  Case 3022  'dupes
    lngLocationID = 0
    GoTo exithere
  Case Else
    MsgBox "Error in Property Get AddNewLocationFromForm: " & Err.Number &
vbCrLf & Err.Description
    Resume exithere
  End Select
End Property




Private Function CreateLineRecords(strFile As String, frm As Form)
  On Error GoTo errhandler
  If gbMcmModuleLogging = True Then Call
mcmModuleLogging("MCM_DoctorsAndOpthalmic", "CreateLineRecords", True)
  Dim dbs As DAO.Database, rst As DAO.Recordset, sql As String
  Set dbs = CurrentDb

  sql = "delete * from Lines"

  Call pfRunSql(sql)


  sql = "Select * from Lines"
  Set rst = dbs.OpenRecordset(sql)

  Dim strTemp As String, iPos2 As Integer
  Dim i As Integer, iASC As Integer, iPos As Integer, strOut As String,
strIn As String
  Dim strFullIn As String, strFullOut As String
  Dim bContinuation As Boolean
  bContinuation = True

  ReadingCount = 0
  frm!ReadingFile = "Reading " & strFile
  frm!ReadingCount = ReadingCount
  WritingCount = 0
  frm!ReadingFile = "Writing Line Records " & strFile
  frm!WritingCount = WritingCount
  frm.Repaint

  Open strFile For Input As #3
  Do While Not EOF(3)
    Input #3, strTemp
    If Len(Trim(strTemp)) > 0 Then
      ' see if this is a continuation or new line
      bContinuation = False
      For i = 1 To 24
        bContinuation = True
        If InStr(strTemp, ary(i)) > 0 Then
          bContinuation = False
          Exit For
        End If
      Next i
      If bContinuation Then
        rst.Edit
        'rst!Line = rst!Line & vbCrLf & str
        rst!Line = rst!Line & ", " & Trim(strTemp)
        rst.Update
      Else
        rst.AddNew
        rst!Line = strTemp
        rst.Update
        rst.Bookmark = rst.LastModified
        WritingCount = WritingCount + 1
      End If
    End If
    ReadingCount = ReadingCount + 1
    frm!ReadingCount = ReadingCount
    frm!WritingCount = WritingCount
    frm.Repaint
  Loop
exithere:
  If gbMcmModuleLogging = True Then Call
mcmModuleLogging("MCM_DoctorsAndOpthalmic", "CreateLineRecords", False)
  Close 3
  Set rst = Nothing
  Exit Function
errhandler:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  GoTo exithere
End Function

--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com