VBA Loop to Combine Records

[admessing]

Well it works. Just one more thing and then I can put this whole thing to bed once and for all:



There may be a likelyhood that a few plots may have a third photo series before this DB runs out its life cycle. In the code provided above...how would I modify it to add the third year and photo series?

I know what I have to do to modify the output table....just need to know the VBA to populate the third set (and where to put it).

Thanks

[ssanfu]

Well it works. Just one more thing and then I can put this whole thing to bed once and for all:

There may be a likelyhood that a few plots may have a third photo series before this DB runs out its life cycle. In the code provided above...how would I modify it to add the third year and photo series?

I know what I have to do to modify the output table....just need to know the VBA to populate the third set (and where to put it).

Thanks

I've been working on it.... can't upload attachments from the work computer, have to startup my laptop.


Here is the new code (in Module 1). NOTE: There is a "2" added to the sub name. Attached is the new zip.....

Function Get_DB_Values2()
'Get values from a table using a query in VBA.
'Process values row by row.
'Insert processed row into another Table.

'On Error GoTo Error_Handle

   Dim db As DAO.Database
   Dim rs As DAO.Recordset

   Dim RC As Long   ' number of records in recordset "r"

   Dim lngCoordID As Long
   Dim strProc_Region As String
   Dim strProc_Forest As String
   Dim strFSVeg_Location As String
   Dim strFSVeg_Stand_Num As String
   Dim dblUTM_Easting As Double
   Dim dblUTM_Northing As Double
   Dim lngUTM_Zone As Long
   Dim strUTM_Datum As String
   Dim dblLAT_DD As Double
   Dim dblLON_DD As Double
   Dim strLAT_LON_Datum As String
   Dim intPhoto_Year As Integer
   Dim strNorth As String
   Dim strEast As String
   Dim strSouth As String
   Dim strWest As String

   Dim lngNewCoordID As Long
   Dim intPrevCoordID As Integer

   Dim intRecordCount As Integer

   Dim intNewPhoto_Year As Integer
   Dim strNewNorth As String
   Dim strNewEast As String
   Dim strNewSouth As String
   Dim strNewWest As String

   Dim intNewPhoto_Year3 As Integer
   Dim strNewNorth3 As String
   Dim strNewEast3 As String
   Dim strNewSouth3 As String
   Dim strNewWest3 As String

   Dim strSQL As String

   'initalize variables
   Set db = CurrentDb
   intRecordCount = 0

   'I don't like deleting and recreating tables. create it once - delect all records to clear table.
   '   CurrentDb.Execute "DROP TABLE Photo_Test"   'This is to delete the table from previous runs of the code
   '   CurrentDb.Execute "Create_Photo_Test"   'This is the create table query where the data needs to end up

   db.Execute "DELETE * FROM Photo_Test"   'This is to clear the table from previous runs of the code

   'open record set
   strSQL = "Select * From Link2 ORDER BY CoordID, Photo_Year "

   Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
   rs.MoveLast   ' to fully populate the recordset
   rs.MoveFirst
   RC = rs.RecordCount

   With rs
      lngNewCoordID = ![CoordID]

      'This Do While loop goes through all the records in recordset strSQL.
      Do While Not rs.EOF
         If lngNewCoordID <> intPrevCoordID Then
            'Populate current (new) row values into variables.
            lngCoordID = ![CoordID]
            strProc_Region = ![Proc_Region]
            strProc_Forest = ![Proc_Forest]
            strFSVeg_Location = ![FSVeg_Location]
            strFSVeg_Stand_Num = ![FSVeg_Stand_Num]
            dblUTM_Easting = ![UTM_Easting]
            dblUTM_Northing = ![UTM_Northing]
            lngUTM_Zone = ![UTM_Zone]
            strUTM_Datum = ![UTM_Datum]
            dblLAT_DD = ![LAT_DD]
            dblLON_DD = ![LON_DD]
            strLAT_LON_Datum = ![LAT_LON_Datum]
            intPhoto_Year = ![Photo_Year]
            strNorth = ![North]
            strEast = ![East]
            strSouth = ![South]
            strWest = ![West]
         Else
            Select Case intRecordCount
                  'Same CoordID - concatenate values.
               Case 1
                  intNewPhoto_Year = ![Photo_Year]
                  strNewNorth = ![North]
                  strNewEast = ![East]
                  strNewSouth = ![South]
                  strNewWest = ![West]
               Case 2
                  intNewPhoto_Year3 = ![Photo_Year]
                  strNewNorth3 = ![North]
                  strNewEast3 = ![East]
                  strNewSouth3 = ![South]
                  strNewWest3 = ![West]
            End Select
         End If

         'next record in recordset.
         .MoveNext
         If Not .EOF Then
            'update variables
            intRecordCount = intRecordCount + 1
            intPrevCoordID = lngCoordID
            lngNewCoordID = ![CoordID]
         End If

         If lngNewCoordID <> intPrevCoordID Then
            'CoordID changed - Write the record to other table.
            'Create Insert SQL string.
            strSQL = "INSERT INTO Photo_Test (CoordID, Proc_Region, Proc_Forest, FSVeg_Location,"
            strSQL = strSQL & " FSVeg_Stand_Num, UTM_Easting, UTM_Northing, UTM_Zone, UTM_Datum,"
            strSQL = strSQL & " LAT_DD, LON_DD, LAT_LON_Datum, Photo_Year_1, North_1, East_1,"
            strSQL = strSQL & " South_1, West_1, Photo_Year_2, North_2, East_2, South_2, West_2,"
            strSQL = strSQL & " Photo_Year_3, North_3, East_3, South_3, West_3)"
            strSQL = strSQL & " VALUES ( " & lngCoordID & ", '"
            strSQL = strSQL & strProc_Region & "', '" & strProc_Forest & "', '"
            strSQL = strSQL & strFSVeg_Location & "', '" & strFSVeg_Stand_Num & "', "
            strSQL = strSQL & dblUTM_Easting & ", " & dblUTM_Northing & ", "
            strSQL = strSQL & lngUTM_Zone & ", '" & strUTM_Datum & "', "
            strSQL = strSQL & dblLAT_DD & ", " & dblLON_DD & ", '"
            strSQL = strSQL & strLAT_LON_Datum & "', "
            strSQL = strSQL & intPhoto_Year & ", '" & strNorth & "', '"
            strSQL = strSQL & strEast & "', '" & strSouth & "', '"
            strSQL = strSQL & strWest & "', " & intNewPhoto_Year & ", '"
            strSQL = strSQL & strNewNorth & "', '" & strNewEast & "', '"
            strSQL = strSQL & strNewSouth & "', '" & strNewWest & "', "
            strSQL = strSQL & intNewPhoto_Year3 & ", '"
            strSQL = strSQL & strNewNorth3 & "', '" & strNewEast3 & "', '"
            strSQL = strSQL & strNewSouth3 & "', '" & strNewWest3 & "'); "
            '               Debug.Print strSQL

            'Execute Insert SQL string
            db.Execute strSQL, dbFailOnError

            'clear variables
            strProc_Region = Empty
            strProc_Forest = Empty
            strFSVeg_Location = Empty
            strFSVeg_Stand_Num = Empty
            dblUTM_Easting = Empty
            dblUTM_Northing = Empty
            lngUTM_Zone = Empty
            strUTM_Datum = Empty
            dblLAT_DD = Empty
            dblLON_DD = Empty
            strLAT_LON_Datum = Empty
            intPhoto_Year = Empty
            strNorth = Empty
            strEast = Empty
            strSouth = Empty
            strWest = Empty

            intNewPhoto_Year = Empty
            strNewNorth = Empty
            strNewEast = Empty
            strNewSouth = Empty
            strNewWest = Empty

            intNewPhoto_Year3 = Empty
            strNewNorth3 = Empty
            strNewEast3 = Empty
            strNewSouth3 = Empty
            strNewWest3 = Empty

            intRecordCount = 0

         End If   'End If lngNewCoordID <> intPrevCoordID And intRecordCount > 0 Then

      Loop   'Back to 'Do While' to check if we are at the end of the file.

      'Create SQL for Last Row of data that is still stored even though Access found the EOF.
      strSQL = "INSERT INTO Photo_Test (CoordID, Proc_Region, Proc_Forest, FSVeg_Location,"
      strSQL = strSQL & " FSVeg_Stand_Num, UTM_Easting, UTM_Northing, UTM_Zone, UTM_Datum,"
      strSQL = strSQL & " LAT_DD, LON_DD, LAT_LON_Datum, Photo_Year_1, North_1, East_1,"
      strSQL = strSQL & " South_1, West_1, Photo_Year_2, North_2, East_2, South_2, West_2,"
      strSQL = strSQL & " Photo_Year_3, North_3, East_3, South_3, West_3)"
      strSQL = strSQL & " VALUES ( " & lngCoordID & ", '"
      strSQL = strSQL & strProc_Region & "', '" & strProc_Forest & "', '"
      strSQL = strSQL & strFSVeg_Location & "', '" & strFSVeg_Stand_Num & "', "
      strSQL = strSQL & dblUTM_Easting & ", " & dblUTM_Northing & ", "
      strSQL = strSQL & lngUTM_Zone & ", '" & strUTM_Datum & "', "
      strSQL = strSQL & dblLAT_DD & ", " & dblLON_DD & ", '"
      strSQL = strSQL & strLAT_LON_Datum & "', "
      strSQL = strSQL & intPhoto_Year & ", '" & strNorth & "', '"
      strSQL = strSQL & strEast & "', '" & strSouth & "', '"
      strSQL = strSQL & strWest & "', " & intNewPhoto_Year & ", '"
      strSQL = strSQL & strNewNorth & "', '" & strNewEast & "', '"
      strSQL = strSQL & strNewSouth & "', '" & strNewWest & "', "
      strSQL = strSQL & intNewPhoto_Year3 & ", '"
      strSQL = strSQL & strNewNorth3 & "', '" & strNewEast3 & "', '"
      strSQL = strSQL & strNewSouth3 & "', '" & strNewWest3 & "'); "

      '               Debug.Print strSQL

      'Insert SQL.
      db.Execute strSQL, dbFailOnError
   End With

   If Not rs Is Nothing Then
      rs.Close
      Set rs = Nothing
   End If
   Set db = Nothing
   MsgBox "DONE!!"
'   Exit Function
   'Error_Handle:
'   Resume Exit_Get_DB_Values
End Function

[admessing]

I owe you one...will test it out and see how it goes.

[admessing]

SUCCESS!!!!

Thank you, Thank you Thank you!!!

[ssanfu]

excellent!!

[admessing]

excellent!!

LOL...I spoke too soon..

When I migrated the script to the real DB, I get the error:

Run-time error "3022":

The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. Change the data in the field or fields that contain duplicate data, remove the index, or redefine the index to permit duplicate entries & try again.

All I did was export everything from the test DB to the real one. Everything is set up with the same data definitions. The only difference is that as of right now, there are no duplicate coordinate sets (all singular occurances), and there are 5033 records instead of ~60.

If I tell it to "end", I get the right number of records. If I tell it to debug....it points to the db.Execute strSQL, dbFailONError line. Changing the CoordID to a reg number just makes for a duplicate final CoordID with no data.

What is going on?

[ssanfu]

Which "db.Execute strSQL, dbFailONError line"? There are two of them.

Is my "Photo_Test" table the same as your "Photo_Test" table? The field types, PK????

Can you zip the Excel file with the 5033 records and attach it?

[admessing]

Which "db.Execute strSQL, dbFailONError line"? There are two of them.

The second one.

Is my "Photo_Test" table the same as your "Photo_Test" table? The field types, PK????

They are identical in every way.

Can you zip the Excel file with the 5033 records and attach it?

Unfortunately no, I can't. It won't compress enough to get under the file size requirements. And it is a DB..not an Excel file. Besides...I can only "publish" the test data outside of the agency due to data security reasons.

I worked on it a bit and the VBA only blows up when I run it on the real DB with only a single set of records. I dummied the real DB with duplicate data (just changed the years), and tested the script...it worked just fine then. So I have come to the conclussion that it simply does not like the single record in the expanded script. To deal with this, I have both versions of the VBA available and ready for my user admins to change once the records get to the point of the expanded script....along with very explicit instructions on what to do, when to do it, and where to put it.

[ssanfu]

The second one.



They are identical in every way.



Unfortunately no, I can't. It won't compress enough to get under the file size requirements. And it is a DB..not an Excel file. Besides...I can only "publish" the test data outside of the agency due to data security reasons.

I worked on it a bit and the VBA only blows up when I run it on the real DB with only a single set of records. I dummied the real DB with duplicate data (just changed the years), and tested the script...it worked just fine then. So I have come to the conclussion that it simply does not like the single record in the expanded script. To deal with this, I have both versions of the VBA available and ready for my user admins to change once the records get to the point of the expanded script....along with very explicit instructions on what to do, when to do it, and where to put it.

I understand about the security issues, I deal with it also. How about 20 lines, including the line(s) that cause it to blow up; with the data munged?

It shouldn't blow up like that, I'd like to try and fix it....