XML code creating two records in Access instead of one

[josephwc]

Please Help
I have a module in MS Access XP which is downloading and saving fields from an external source to a table. The code is taking the external field names and making each one a record. If the field names are Red, Blue, Green Field1 in the table would have three records with the value Red, Blue, and Green. The original values that were contained in these external fields are placed in Field2 of the table.

Field1 Field2
Red 250
Blue 100
Green 50

There are other external fields named similarly but with the word " Forecast" after the name (ex. Red Forecast, Blue Forecast, Green Forecast) I am attempting to place the values contained in these external fields within the same table and record as the 1st set of external fields based on the name of the field without the word " Forecast".

Field1 Field2 Field3
Red 250 20
Blue 100 50
Green 50 10

The way the XML and VBA code is currently structured I am getting two separate records. How do I get the data from all these external fields within the same record?
Code contained below
Dim sFunctionValue As String
Dim sFunctionForecast As String

sFunctionValue = ""
sFunctionForecast = ""

' Get the custom fields
Set objCustomFieldList = pobjNode.selectSingleNode("customFields").childNodes

For i = 0 To objCustomFieldList.length - 1
Set objCustomField = objCustomFieldList.nextNode

Set objAttributes = objCustomField.Attributes
sCustomFieldName = objAttributes.getNamedItem("name").nodeValue



Select Case sCustomFieldName

Case "Tower Group Forecast"
sFunctionForecast = XML_GetChildNodeValue(objCustomField, "value")
Case "WCS EMS Forecast"
sFunctionForecast = XML_GetChildNodeValue(objCustomField, "value")
Case "WCS ENH Forecast"
sFunctionForecast = XML_GetChildNodeValue(objCustomField, "value")
Case "WCS Fee Srvcs Forecast"
sFunctionForecast = XML_GetChildNodeValue(objCustomField, "value")
Case Else
'Retrieve Function Custom Field Value...
sFunctionValue = XML_GetChildNodeValue(objCustomField, "value")
End Select

If Not IsNull(sFunctionValue) Or (sFunctionValue <> "") Then
Call AddFunctionData("9999999", sCustomFieldName, sFunctionValue)
sFunctionValue = ""
End If


If Not IsNull(sFunctionForecast) Or (sFunctionForecast <> "") Then
Call AddFunctionDataForecast("9999999", sCustomFieldName, sFunctionForecast)
sFunctionForecast = ""
End If
Next


'********************************************************************************
' Procedure Name: AddFunctionData
' Description: Save Function Data (from Project) into a separate Table
' Input Parameters: pcode (string): Project Code
' fname (string): Function Name
' famount (string): Function Amount (include Zero values)
'
' Return Parameters: none
'********************************************************************************

Private Sub AddFunctionData(pCode As String, fcode As String, fvalue As String)
Dim db As DAO.Database
Dim rec1, rds As DAO.Recordset
Dim sQuery As String

On Error GoTo ErrorHandler

' Check if function is part of static data...
sQuery = "SELECT code FROM StaticData WHERE staticDataType = 'functionName' " & _
"AND code = '" & fcode & "' "

Set rds = CurrentDb.OpenRecordset(sQuery)

If rds.RecordCount = 1 Then

If fvalue <> "" Then
Set db = CurrentDb()
Set rec1 = db.OpenRecordset("ProjectFunction")

rec1.AddNew
rec1!internalProjectId = Val(pCode)
rec1!FunctionCode = fcode
rec1!FunctionValue = fvalue


rec1.Update

rec1.Close

End If
End If

rds.Close

ExitHere:
Exit Sub

ErrorHandler:
' Just attach the function name and keep raising the error
Err.Description = "AddFunctionData:" & Err.Description
Err.Raise (Err.Number)
End Sub
'********************************************************************************
' Procedure Name: AddFunctionDataForecast
' Description: Save Function Data (from Project) into a separate Table
' Input Parameters: pcode (string): Project Code
' fname (string): Function Name
'
' fforecast (string): Function Forecast
' Return Parameters: none
'********************************************************************************

Private Sub AddFunctionDataForecast(pCode As String, fcode As String, fforecast As String)
Dim db As DAO.Database
Dim rec1, rds As DAO.Recordset
Dim sQuery As String

On Error GoTo ErrorHandler

' Check if function is part of static data...
sQuery = "SELECT code FROM StaticData WHERE staticDataType = 'functionName' " & _
"AND code & ' Forecast' = '" & fcode & "' "

Set rds = CurrentDb.OpenRecordset(sQuery)

If rds.RecordCount = 1 Then

If fforecast <> "" Then
Set db = CurrentDb()
Set rec1 = db.OpenRecordset("ProjectFunction")

rec1!.AddNew
rec1!internalProjectId = Val(pCode)
rec1!past = Left(fforecast, 3)
rec1!jan2006 = Mid(fforecast, 4, 3)
rec1!feb2006 = Mid(fforecast, 7, 3)
rec1!mar2006 = Mid(fforecast, 10, 3)
rec1!apr2006 = Mid(fforecast, 13, 3)
rec1!may2006 = Mid(fforecast, 16, 3)
rec1!jun2006 = Mid(fforecast, 19, 3)
rec1!jul2006 = Mid(fforecast, 22, 3)
rec1!aug2006 = Mid(fforecast, 25, 3)
rec1!sep2006 = Mid(fforecast, 28, 3)
rec1!oct2006 = Mid(fforecast, 31, 3)
rec1!nov2006 = Mid(fforecast, 34, 3)
rec1!dec2006 = Mid(fforecast, 37, 3)
rec1!jan2007 = Mid(fforecast, 40, 3)
rec1!feb2007 = Mid(fforecast, 43, 3)
rec1!mar2007 = Mid(fforecast, 46, 3)
rec1!apr2007 = Mid(fforecast, 49, 3)
rec1!may2007 = Mid(fforecast, 52, 3)
rec1!jun2007 = Mid(fforecast, 55, 3)
rec1!jul2007 = Mid(fforecast, 58, 3)
rec1!aug2007 = Mid(fforecast, 61, 3)
rec1!sep2007 = Mid(fforecast, 64, 3)
rec1!oct2007 = Mid(fforecast, 67, 3)
rec1!nov2007 = Mid(fforecast, 70, 3)
rec1!dec2007 = Mid(fforecast, 73, 3)
rec1!future = Right(fforecast, 3)


rec1.Update

rec1.Close

End If

End If

rds.Close

ExitHere:
Exit Sub

ErrorHandler:
' Just attach the function name and keep raising the error
Err.Description = "AddFunctionDataForecast:" & Err.Description
Err.Raise (Err.Number)
End Sub

 

[josephwc]

Nevermind. I found a work around.