Results 1 to 6 of 6

Thread: Help with Code

  1. #1
    Join Date
    Jan 2016
    Posts
    3

    Unanswered: Help with Code

    I am trying to add some additional fields to the catch_entry and catch_permanent tables in my database. When I add those fields to the transfer module below (to move data from entry side to permanent side), I get an error when the code encounters records it would need to aggregate. Can someone look at the code and tell me if it looks like I need to add these fields anywhere else in my database? I do not know programming so I don't know how to add these fields so they will transfer the data from those fields. I took out some of the code below that was for other tables in the database.
    

    ' Module : Module Transfer
    ' Description: Procedures to transfer data from the entry database to the
    ' permanent database.
    ' Procedures : TransferData
    ' ExecuteTransferStep
    ' UpdateTransferStatus
    ' ************************************************** ****************************
    Option Compare Database
    Option Explicit

    Private Const mcProgressForm As String = "frmTransferProgress"
    Private mfrmProgress As Form

    Public Sub TransferData(strUserName As String)
    ' Purpose : Create and execute a series of queries to move data from
    ' the data entry tables to the permanent tables.
    ' NOTE: Once the data is moved, it is deleted from the entry tables,
    ' using cascade deletes.
    ' Parameters : strUserName - If not set to "" then transfer only the specified user's data.
    ' Returns : -
    ' History : Created 1/19/99 by MarcV; Last modified 9/1/99 by MarcV.
    '
    On Error GoTo TransferData_ERR

    Dim strUserClause As String
    Dim wrkCurrent As Workspace
    Dim lngSample As Long
    Dim lngSeineEffort As Long
    Dim lngTrapEffort As Long
    Dim lngCatch As Long
    Dim lngMarking As Long
    Dim lngRelease As Long
    Dim lngPreRelease As Long
    Dim rstSample_E As DAO.Recordset
    Dim rstSample As DAO.Recordset
    Dim rstSeineEffort_E As DAO.Recordset
    Dim rstSeineEffort As DAO.Recordset
    Dim rstTrapEffort_E As DAO.Recordset
    Dim rstTrapEffort As DAO.Recordset
    Dim rstCatch_E As DAO.Recordset
    Dim rstCatch As DAO.Recordset
    Dim rstMarking_E As DAO.Recordset
    Dim rstMarking As DAO.Recordset
    Dim rstRelease_E As DAO.Recordset
    Dim rstRelease As DAO.Recordset
    Dim rstPreRelease_E As DAO.Recordset
    Dim rstPreRelease As DAO.Recordset
    Dim fld As DAO.Field

    ' Set the global database object
    Set gdbsMyDb = CurrentDb

    ' Get the default workspace
    Set wrkCurrent = DBEngine.Workspaces(0)

    ' Open progress form
    DoCmd.OpenForm mcProgressForm, acNormal, "", "TransferTime > #" & Now() & "#"
    Set mfrmProgress = Forms(mcProgressForm)
    ' Create new record
    DoCmd.GoToRecord acForm, mfrmProgress.Name, acNewRec
    mfrmProgress.txtTransferTime = Now()
    mfrmProgress.txtUserName = CurrentUser()

    ' Prepare where clause fragment for selecting a particular user's data only, if requested
    ' NOTE: Some applications may not distinguish among users and thus do not use this clause
    If strUserName <> "" Then
    ' tranfer data for the specified user only
    strUserClause = "UserName = " & gcQuote & strUserName & gcQuote
    Else
    ' transfer all users' data
    strUserClause = "UserName <> Null"
    End If

    ' Open tables on the permanent side
    Set rstSample = gdbsMyDb.OpenRecordset("Sample")
    Set rstSeineEffort = gdbsMyDb.OpenRecordset("SeineEffort")
    Set rstTrapEffort = gdbsMyDb.OpenRecordset("TrapEffort")
    Set rstCatch = gdbsMyDb.OpenRecordset("Catch")
    Set rstMarking = gdbsMyDb.OpenRecordset("Marking")
    Set rstRelease = gdbsMyDb.OpenRecordset("Release")
    Set rstPreRelease = gdbsMyDb.OpenRecordset("PreRelease")


    'Open the master table on the entry side and type its records by MethodType
    ' also include a where clause for selecting a particular user's data only
    Set rstSample_E = gdbsMyDb.OpenRecordset( _
    "SELECT S.*, M.MethodType " & _
    "FROM MethodsLookUp M INNER JOIN Sample_Entry S " & _
    "ON M.MethodCode = S.MethodCode " & _
    "WHERE S." & strUserClause & ";")

    ' NOTE: The following code assumes that corresponding fields have the same name
    ' in the entry and the permanent table sets.

    ' Cycle through all records in the master table
    While Not rstSample_E.EOF
    ' Begin a transaction
    wrkCurrent.BeginTrans

    ' Add a new record to the sample table
    rstSample.AddNew
    ' Transfer fields with the same name, excluding GUID and system fields
    For Each fld In rstSample_E.Fields
    If (fld.Type <> dbGUID) And (fld.Attributes And dbSystemField) = 0 Then
    rstSample.Fields(fld.Name) = fld
    End If
    Next fld
    rstSample.Update
    lngSample = lngSample + 1
    ' Move cursor back to last modified record to get the new RowID
    rstSample.Move 0, rstSample.LastModified


    ' Get and process the corresponding Catch_Entry records
    ' NOTE: Here records are aggregated
    Set rstCatch_E = gdbsMyDb.OpenRecordset( _
    "SELECT OrganismCode, ForkLength, TotalLength, Weight, Dead, " & _
    "StageCode, MarkCode, Race, ReleaseCode, " & _
    "Sum(Count) as TotalCount " & _
    "From Catch_Entry WHERE SampleRowID = " & rstSample_E!SampleRowID & " " & _
    "GROUP BY OrganismCode, ForkLength, TotalLength, Weight, Dead, " & _
    "StageCode, MarkCode, Race, ReleaseCode;")

    While Not rstCatch_E.EOF
    rstCatch.AddNew
    ' Set foreign key
    rstCatch!SampleRowID = rstSample!SampleRowID
    ' Set aggregation total
    rstCatch!Count = rstCatch_E!TotalCount
    ' Transfer fields with the same name, excluding GUID and system fields
    For Each fld In rstCatch_E.Fields
    If (fld.Type <> dbGUID) And (fld.Attributes And dbSystemField) = 0 Then
    rstCatch.Fields(fld.Name) = fld
    End If
    Next fld
    ' Update, increment counter and move to next entry record
    rstCatch.Update
    lngCatch = lngCatch + 1
    rstCatch_E.MoveNext
    Wend
    'Close Catch_Entry recordSet
    rstCatch_E.Close

    ' Check if user cancelled
    If UserCancelled(mfrmProgress) Then
    Err.Raise Number:=vbObjectError + 398, Description:="Transfer interrupted by user."
    End If

    ' Delete the records that have been transfered
    ' Note: this assumes cascade deletes between Sample_Entry and related tables.
    rstSample_E.Delete
    ' Since no errors (or user cancel) occurred at this point, commit the changes to disk and exit
    wrkCurrent.CommitTrans

    ' Update the progress form and through it the TransferLog table
    mfrmProgress.txtSample = lngSample
    mfrmProgress.txtSeineEffort = lngSeineEffort
    mfrmProgress.txtTrapEffort = lngTrapEffort
    mfrmProgress.txtCatch = lngCatch
    mfrmProgress.txtMarking = lngMarking
    mfrmProgress.txtrelease = lngRelease
    mfrmProgress.txtPreRelease = lngPreRelease

    ' Move to the next record to transfer
    rstSample_E.MoveNext
    Wend
    rstSample_E.Close

    ' Close recordsets opened on permanent side
    rstSample.Close
    rstSeineEffort.Close
    rstTrapEffort.Close
    rstCatch.Close
    rstMarking.Close
    rstRelease.Close
    rstPreRelease.Close

    ' All records transfered OK, update TransferLog accordingly
    mfrmProgress.txtStatus = "Complete"
    MsgBox "Transfer completed successfully", vbInformation + vbOKOnly, "Data transfer"

    TransferData_Done:
    DoCmd.Close acForm, mcProgressForm
    On Error GoTo 0
    Exit Sub

    TransferData_ERR:
    Select Case Err
    Case 3265 '
    Resume Next
    Case Else
    ReportError "Error#" & Err.Number & ": " & Err.Description, _
    " SOME RECORDS WERE NOT TRANSFERED", _
    "Module Transfer: TransferData"
    ' An error occured, roll back the changes.
    wrkCurrent.Rollback
    ' Update TransferLog accordingly
    mfrmProgress.txtStatus = "Interrupted"
    Resume TransferData_Done
    End Select
    End Sub
    Last edited by waterski79; 01-22-16 at 17:42. Reason: forgot attachment

  2. #2
    Join Date
    Mar 2016
    Posts
    1
    By just compiling i got this: you are missing some declarations and procedures.
    You have removed too much code. Put it back and try again.

    Public Function UserCancelled(frm As Form) As Boolean
    ' Missing function Usercancelled
    UserCancelled = False
    End Function
    Public Sub ReportError(strError As String, strMessage As String, strmodule As String)
    ' Missing procedure ReportError
    End Sub

    ' Missing following declarations
    Const gcQuote = "Some quote"
    Dim gdbsMyDb As Database

  3. #3
    Join Date
    Jan 2016
    Posts
    3

    Need more help

    Thank you for your reply. I haven't been able to work on this database in awhile due to other work commitments. I did not take any of the code out of my actual database, I just took it out of the posting because it was too long to post. I have not been able to resolve my issue. To be more clear, I added a few more fields to the catch_entry table and added data to that. At the end of the year, once all of my data is final, I need to transfer it to the table catch_permanent. I added these same fields to the catch_permanent side but when I run this module everything transfers correctly except no data is transferred to the new fields. I do not know much about programming. I can copy and paste and edit (swap out names/values) existing code but I don't know what it all means and how to write new code or modify existing code. I thought that adding two more fields wouldn't affect the code and everything would transfer based on what the code says (if fields exist in both tables then transfer...or something to that effect). Any ideas on what I need to do to the code I pasted in the original thread. I think it may be getting stuck on the compilation part where it pools the data together if all values are the same and then increases the count by that number of records.

  4. #4
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    ok so what line is the code failing on
    or what isn't happening that should (or conversely what is happening that shouldn't)
    I'd rather be riding on the Tiger 800 or the Norton

  5. #5
    Join Date
    Jan 2016
    Posts
    3

    Re:Help with Code

    The code doesn't "fail". It runs successfully, it just ignores the data in these new fields and no data is added to those fields but all other fields for each record transfer successfully.

  6. #6
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    Ok so put a watch/breakpoint on tbe code and step through it.
    Its possible that you are not supplying values.
    Make certain each line ofcode does what you think it should
    I'd rather be riding on the Tiger 800 or the Norton

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •