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.
'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 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
'This Do While loop 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 - concatenate values.
'This is where the FUN begins.....Yeah Right
intNewPhoto_Year = ![Photo_Year]
strNewNorth = ![North]
strNewEast = ![East]
strNewSouth = ![South]
strNewWest = ![West]
Else '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 & " 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 string
db.Execute strSQL, dbFailOnError
'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]
'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 record in recordset.
End If
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 & " 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 "DONE!!"
Exit Function
'Error_Handle:
Resume Exit_Get_DB_Values
End Function
Windows XP 
Access 2007
...
Reply With Quote
Source Table Example
)
Originally Posted by ssanfu
Arrgh!!!
