VBA Loop addition

admessing

Registered User.
Local time
Today, 06:05
Joined
Feb 6, 2012
Messages
32
I need a little guidance here. I need to add to this VBA a means by which to deal with a third possible matching CoordID and its related data (Photo_Year, and image links (4)). This VBA as is works just fine for combining 2 records, I just need to get it up to a third:

Code:
Option Compare Database
Option Explicit
Function Get_DB_Values()
'Get values from a table using a query in VBA.
'Process values row by row.
'Insert processed row into another Table.
   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 strSQL As String
   'initalize variables
   Set db = CurrentDb
   intRecordCount = 0
   'delete all records in table.
   db.Execute "DELETE * FROM Photo_Plots"      'open record set
   strSQL = "Select * From Photo_Link_2 ORDER BY CoordID, Photo_Year "
   Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
   rs.MoveLast   'populate recordset
   rs.MoveFirst
   RC = rs.RecordCount
   With rs
      'goes through all the records in strSQL.
      Do While Not rs.EOF
         If intRecordCount < 1 Then
            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   'Not first record.
            lngNewCoordID = ![CoordID]
            If lngNewCoordID = intPrevCoordID Then   'Same CoordID - combine records.
               intNewPhoto_Year = ![Photo_Year]
               strNewNorth = ![North]
               strNewEast = ![East]
               strNewSouth = ![South]
               strNewWest = ![West]
            Else   'CoordID changed - Write to other table.
               'Create Insert SQL string.
               strSQL = "INSERT INTO Photo_Plots (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 & " 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 & "'); "
               'Debug.Print strSQL
               'Execute Insert SQL               db.Execute strSQL, dbFailOnError
               'Populate 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]
               'clear variables
               intNewPhoto_Year = Empty
               strNewNorth = Empty
               strNewEast = Empty
               strNewSouth = Empty
               strNewWest = Empty
            End If   'End If lngNewCoordID = intPrevCoordID Then
         End If   'End If intRecordCount < 1
 
         intPrevCoordID = lngCoordID
         If Not .EOF Then
            intRecordCount = intRecordCount + 1
            .MoveNext   'Move to next 
         End If
      Loop   'check if we are at the end of the file.
      'Create SQL for Last Row, found the EOF.
      strSQL = "INSERT INTO Photo_Plots (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 & " 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 & "'); "
      '               Debug.Print strSQL
      'Execute Insert SQL.
      db.Execute strSQL, dbFailOnError
   End With
Exit_Get_DB_Values:
   If Not rs Is Nothing Then
      rs.Close
      Set rs = Nothing
   End If
   Set db = Nothing
   MsgBox "Archive Successfully Updated!!"
   Exit Function
   'Error_Handle:
   Resume Exit_Get_DB_Values
End Function
 

Users who are viewing this thread

Back
Top Bottom