Cant see table data

I am programmatically creating and populating a table (using code supplied).

When I check my database (access) and look in the newly created table I dont
see any data. If I create the query
Select * From tblStockGroupDiscount I get no data returned.
If however I create a query

SELECT tblStockGroupDiscount.sgdi_txt_StockGroupID,
tblStockGroupDiscount.sgdi_sgl_Discount
FROM [Stock Groups] INNER JOIN tblStockGroupDiscount ON [Stock
Groups].StockGroupId = tblStockGroupDiscount.sgdi_txt_StockGroupID;

The data in the table is displayed.

I do not have any filters on the table & I have not selected DataEntry.

Any ideas?

Terry Holland


================================================
Code
================================================

Private Function ApplyUpdate_83()
ApplyUpdate 83, "2.0_29"

Update_AddTableStockGroupDiscount
Update_PopulateStockGroupDiscountTable
Update_AddQueryApplyDiscountRates


End Function

================================================

Private Function Update_AddTableStockGroupDiscount()
Dim tdf As dao.TableDef
Dim idx As dao.Index

If dbBIDS Is Nothing Then modDataBase.OpenBIDSDatabase

'Check if table exists and exit function if it does
For Each tdf In dbBIDS.TableDefs
If tdf.Name = "tblStockGroupDiscount" Then
'dbBIDS.TableDefs.Delete (tdf.Name)
Exit Function
End If
Next

With dbBIDS
Set tdf = .CreateTableDef("tblStockGroupDiscount")

'Add fields to table
Call AddDAOField(tdf, "sgdi_lng_id", dbLong, , dbAutoIncrField)
Call AddDAOField(tdf, "sgdi_txt_StockGroupID", dbText, 6)
Call AddDAOField(tdf, "sgdi_sgl_Discount", dbSingle)

'create primary key
Set idx = tdf.CreateIndex("idxPKStockGroupDiscount")
With idx
.Primary = True
.Fields = "sgdi_lng_id"
End With
tdf.Indexes.Append idx

.TableDefs.Append tdf

End With

'Cant add a relationship as the StockGroups table is a link from another
DB
'Call AddDAORelationship(dbBIDS, "Stock Groups",
"tblStockGroupDiscount", "StockGroupId", "sgdi_txt_StockGroupID",
dbRelationUpdateCascade + dbRelationDeleteCascade)
End Function

================================================

Private Function AddDAOField(tdf As dao.TableDef, StrName As String, dbType
As dao.DataTypeEnum, Optional intLength As Integer = -1, Optional
intAttributes As Integer = -1) As dao.Field
Dim fld As dao.Field
Set fld = New dao.Field
With fld
.Name = StrName
.Type = dbType
If intLength 0 Then .Size = intLength
If intAttributes 0 Then .Attributes = intAttributes
End With

tdf.Fields.Append fld
Set fld = Nothing
End Function


Private Function Update_PopulateStockGroupDiscountTable()
'Populates tblStockGroupDiscount with data in text file
MaterialDiscountRate.txt
Dim objTextFile As New clsTextFile
Dim cmm As ADODB.Command
'Dim strFields As Variant
Dim strValues() As String

Dim rst As New ADODB.Recordset
rst.Open "select * from tblStockGroupDiscount", ADOConnection,
adOpenKeyset, adLockOptimistic

With objTextFile
.OpenFile "MaterialDiscountRate.txt"
'MsgBox "Opened file"
While Not .EndOfFile
strValues = Split(.ReadFromFile, ",")
'MsgBox "Found " & strValues(0) & " in file"

rst.Filter = "sgdi_txt_StockGroupID='" & strValues(0) & "'"
If rst.EOF Then
'MsgBox "Adding " & strValues(0) & " in file"
rst.AddNew 'strFields, strValues
Else
'MsgBox "Updating " & strValues(0) & " in file"

End If

rst.Fields("sgdi_txt_StockGroupID") = strValues(0)
rst.Fields("sgdi_sgl_Discount") = strValues(1)
rst.Update
Wend
.CloseFile
rst.Close
End With

End Function

Some of your code appears to be missing, so it's not easy to reconstruct
your situation (see my comments below).

-- Vincent Johns
Please feel free to quote anything I say here.

Terry Holland wrote:

I am programmatically creating and populating a table (using code supplied).

When I check my database (access) and look in the newly created table I dont
see any data. If I create the query
Select * From tblStockGroupDiscount I get no data returned.
If however I create a query

SELECT tblStockGroupDiscount.sgdi_txt_StockGroupID,
tblStockGroupDiscount.sgdi_sgl_Discount
FROM [Stock Groups] INNER JOIN tblStockGroupDiscount ON [Stock
Groups].StockGroupId = tblStockGroupDiscount.sgdi_txt_StockGroupID;

The data in the table is displayed.

I do not have any filters on the table & I have not selected DataEntry.

Any ideas?

Terry Holland


================================================
Code
================================================

Private Function ApplyUpdate_83()
ApplyUpdate 83, "2.0_29"

I need a definition for ApplyUpdate

Update_AddTableStockGroupDiscount
Update_PopulateStockGroupDiscountTable
Update_AddQueryApplyDiscountRates

.... and for Update_AddQueryApplyDiscountRates


End Function

================================================

Private Function Update_AddTableStockGroupDiscount()
Dim tdf As dao.TableDef
Dim idx As dao.Index

If dbBIDS Is Nothing Then modDataBase.OpenBIDSDatabase

.... and for dbBIDS and for modDataBase

'Check if table exists and exit function if it does
For Each tdf In dbBIDS.TableDefs
If tdf.Name = "tblStockGroupDiscount" Then
'dbBIDS.TableDefs.Delete (tdf.Name)
Exit Function
End If
Next

With dbBIDS
Set tdf = .CreateTableDef("tblStockGroupDiscount")

'Add fields to table
Call AddDAOField(tdf, "sgdi_lng_id", dbLong, , dbAutoIncrField)
Call AddDAOField(tdf, "sgdi_txt_StockGroupID", dbText, 6)
Call AddDAOField(tdf, "sgdi_sgl_Discount", dbSingle)

'create primary key
Set idx = tdf.CreateIndex("idxPKStockGroupDiscount")
With idx
.Primary = True
.Fields = "sgdi_lng_id"
End With
tdf.Indexes.Append idx

.TableDefs.Append tdf

End With

'Cant add a relationship as the StockGroups table is a link from another
DB
'Call AddDAORelationship(dbBIDS, "Stock Groups",
"tblStockGroupDiscount", "StockGroupId", "sgdi_txt_StockGroupID",
dbRelationUpdateCascade + dbRelationDeleteCascade)
End Function

================================================

Private Function AddDAOField(tdf As dao.TableDef, StrName As String, dbType
As dao.DataTypeEnum, Optional intLength As Integer = -1, Optional
intAttributes As Integer = -1) As dao.Field
Dim fld As dao.Field
Set fld = New dao.Field
With fld
.Name = StrName
.Type = dbType
If intLength 0 Then .Size = intLength
If intAttributes 0 Then .Attributes = intAttributes
End With

tdf.Fields.Append fld
Set fld = Nothing
End Function


Private Function Update_PopulateStockGroupDiscountTable()
'Populates tblStockGroupDiscount with data in text file
MaterialDiscountRate.txt
Dim objTextFile As New clsTextFile

.... and for clsTextFile

Dim cmm As ADODB.Command
'Dim strFields As Variant
Dim strValues() As String

Dim rst As New ADODB.Recordset
rst.Open "select * from tblStockGroupDiscount", ADOConnection,

.... and for ADOConnection

adOpenKeyset, adLockOptimistic

With objTextFile
.OpenFile "MaterialDiscountRate.txt"
'MsgBox "Opened file"
While Not .EndOfFile
strValues = Split(.ReadFromFile, ",")
'MsgBox "Found " & strValues(0) & " in file"

rst.Filter = "sgdi_txt_StockGroupID='" & strValues(0) & "'"
If rst.EOF Then
'MsgBox "Adding " & strValues(0) & " in file"
rst.AddNew 'strFields, strValues
Else
'MsgBox "Updating " & strValues(0) & " in file"

End If

rst.Fields("sgdi_txt_StockGroupID") = strValues(0)
rst.Fields("sgdi_sgl_Discount") = strValues(1)
rst.Update
Wend
.CloseFile
rst.Close
End With

End Function

See my notes below.

I realise that there is a mixture of DAO & ADO which is not ideal, but this
is a legacy application that I want to modify as little as possible


Private Function ApplyUpdate_83()
ApplyUpdate 83, "2.0_29"

'ApplyUpdate 83, "2.0_29"
Not relevant so comment out


I need a definition for ApplyUpdate

Update_AddTableStockGroupDiscount
Update_PopulateStockGroupDiscountTable
Update_AddQueryApplyDiscountRates

... and for Update_AddQueryApplyDiscountRates

'Update_AddQueryApplyDiscountRates
also not relevant so comment out




End Function

================================================

Private Function Update_AddTableStockGroupDiscount()
Dim tdf As dao.TableDef
Dim idx As dao.Index

If dbBIDS Is Nothing Then modDataBase.OpenBIDSDatabase

... and for dbBIDS and for modDataBase

dbBids is the variable of type DAO.Database that points to database and
modDataBase.OpenBIDSDatabase is a function that opens the database if it is
not already open
ie

Module modDataBase
=====================
Global dbBIDS As DAO.Database

Public Sub OpenBIDSDatabase()

If dbBIDS Is Nothing Then
Set wsDefault = DBEngine.Workspaces(0)
Set dbBIDS = wsDefault.OpenDatabase(g_objRegistrySettings.Conte stLocation)
End If

End Sub


'Check if table exists and exit function if it does
For Each tdf In dbBIDS.TableDefs
If tdf.Name = "tblStockGroupDiscount" Then
'dbBIDS.TableDefs.Delete (tdf.Name)
Exit Function
End If
Next

With dbBIDS
Set tdf = .CreateTableDef("tblStockGroupDiscount")

'Add fields to table
Call AddDAOField(tdf, "sgdi_lng_id", dbLong, , dbAutoIncrField)
Call AddDAOField(tdf, "sgdi_txt_StockGroupID", dbText, 6)
Call AddDAOField(tdf, "sgdi_sgl_Discount", dbSingle)

'create primary key
Set idx = tdf.CreateIndex("idxPKStockGroupDiscount")
With idx
.Primary = True
.Fields = "sgdi_lng_id"
End With
tdf.Indexes.Append idx

.TableDefs.Append tdf

End With

'Cant add a relationship as the StockGroups table is a link from
another
DB
'Call AddDAORelationship(dbBIDS, "Stock Groups",
"tblStockGroupDiscount", "StockGroupId", "sgdi_txt_StockGroupID",
dbRelationUpdateCascade + dbRelationDeleteCascade)
End Function

================================================

Private Function AddDAOField(tdf As dao.TableDef, StrName As String,
dbType
As dao.DataTypeEnum, Optional intLength As Integer = -1, Optional
intAttributes As Integer = -1) As dao.Field
Dim fld As dao.Field
Set fld = New dao.Field
With fld
.Name = StrName
.Type = dbType
If intLength 0 Then .Size = intLength
If intAttributes 0 Then .Attributes = intAttributes
End With

tdf.Fields.Append fld
Set fld = Nothing
End Function


Private Function Update_PopulateStockGroupDiscountTable()
'Populates tblStockGroupDiscount with data in text file
MaterialDiscountRate.txt
Dim objTextFile As New clsTextFile

... and for clsTextFile

Dim cmm As ADODB.Command
'Dim strFields As Variant
Dim strValues() As String

Dim rst As New ADODB.Recordset
rst.Open "select * from tblStockGroupDiscount", ADOConnection,

... and for ADOConnection


Valid connection to database



adOpenKeyset, adLockOptimistic

With objTextFile
.OpenFile "MaterialDiscountRate.txt"
'MsgBox "Opened file"
While Not .EndOfFile
strValues = Split(.ReadFromFile, ",")
'MsgBox "Found " & strValues(0) & " in file"

rst.Filter = "sgdi_txt_StockGroupID='" & strValues(0) & "'"
If rst.EOF Then
'MsgBox "Adding " & strValues(0) & " in file"
rst.AddNew 'strFields, strValues
Else
'MsgBox "Updating " & strValues(0) & " in file"

End If

rst.Fields("sgdi_txt_StockGroupID") = strValues(0)
rst.Fields("sgdi_sgl_Discount") = strValues(1)
rst.Update
Wend
.CloseFile
rst.Close
End With

End Function


clsTextFile
===============
Option Explicit

Public Enum enuFileOpenMode
ForInput
ForOutput
ForAppend
End Enum

Private m_intFile As Integer

Public Sub OpenFile(strFileName As String, Optional FileOpenMode As
enuFileOpenMode = ForInput, Optional strDirectory As String = "")
'---------------------------------------------------------------------------
------------
' Procedure : OpenFile
' DateTime : 24/10/2005 10:26
' Author : tholland
' Purpose :
'---------------------------------------------------------------------------
------------
'
Dim booSucceed As Boolean
On Error GoTo OpenFile_Error

If strDirectory = "" Then
strDirectory = App.path & "\"
'strDirectory = Left$(strDirectory, InStrRev(strDirectory, "\"))
Else
strDirectory = Trim$(strDirectory)
If Right$(strDirectory, 1) "\" Then strDirectory = strDirectory & "\"
End If

strFileName = strDirectory & strFileName

m_intFile = FreeFile

Select Case FileOpenMode
Case ForInput
Open strFileName For Input As m_intFile

Case ForOutput
On Error Resume Next
Kill strFileName
On Error GoTo 0
Open strFileName For Output As m_intFile

Case ForAppend
Open strFileName For Append As m_intFile

End Select


OpenFile_Exit:
On Error Resume Next
Exit Sub

OpenFile_Error:
On Error Resume Next
Close m_intFile
Resume OpenFile_Exit
End Sub

Public Sub CloseFile()
Close m_intFile
End Sub

Public Sub WriteToFile(strText As String)
Print m_intFile, strText
End Sub

Public Function ReadFromFile() As String
Dim strRetVal As String

If Not EOF(m_intFile) Then
Line Input #m_intFile, strRetVal
End If

ReadFromFile = strRetVal
End Function

Public Function EndOfFile() As Boolean
EndOfFile = EOF(m_intFile)
End Function

Private Sub Class_Initialize()
On Error Resume Next
Close m_intFile

End Sub

Looks good -- I may be able to compile it with these changes. But not
right away; I'm out of time. I'll try to get to it this weekend. If
you need an answer sooner than that, you might try cleaning up the code
and re-posting your question with a new Subject: line, in hopes that
someone else might pick it up. In the meantime, I'll work on this
thread. (If you do solve it before I do, please let me know.)

-- Vincent Johns
Please feel free to quote anything I say here.

Terry Holland wrote:

See my notes below.

I realise that there is a mixture of DAO & ADO which is not ideal, but this
is a legacy application that I want to modify as little as possible



Private Function ApplyUpdate_83()
ApplyUpdate 83, "2.0_29"


'ApplyUpdate 83, "2.0_29"
Not relevant so comment out


I need a definition for ApplyUpdate


Update_AddTableStockGroupDiscount
Update_PopulateStockGroupDiscountTable
Update_AddQueryApplyDiscountRates

... and for Update_AddQueryApplyDiscountRates


'Update_AddQueryApplyDiscountRates
also not relevant so comment out



End Function

=============================================== =

Private Function Update_AddTableStockGroupDiscount()
Dim tdf As dao.TableDef
Dim idx As dao.Index

If dbBIDS Is Nothing Then modDataBase.OpenBIDSDatabase

... and for dbBIDS and for modDataBase


dbBids is the variable of type DAO.Database that points to database and
modDataBase.OpenBIDSDatabase is a function that opens the database if it is
not already open
ie

Module modDataBase
=====================
Global dbBIDS As DAO.Database

Public Sub OpenBIDSDatabase()

If dbBIDS Is Nothing Then
Set wsDefault = DBEngine.Workspaces(0)
Set dbBIDS = wsDefault.OpenDatabase(g_objRegistrySettings.Conte stLocation)
End If

End Sub


'Check if table exists and exit function if it does
For Each tdf In dbBIDS.TableDefs
If tdf.Name = "tblStockGroupDiscount" Then
'dbBIDS.TableDefs.Delete (tdf.Name)
Exit Function
End If
Next

With dbBIDS
Set tdf = .CreateTableDef("tblStockGroupDiscount")

'Add fields to table
Call AddDAOField(tdf, "sgdi_lng_id", dbLong, , dbAutoIncrField)
Call AddDAOField(tdf, "sgdi_txt_StockGroupID", dbText, 6)
Call AddDAOField(tdf, "sgdi_sgl_Discount", dbSingle)

'create primary key
Set idx = tdf.CreateIndex("idxPKStockGroupDiscount")
With idx
.Primary = True
.Fields = "sgdi_lng_id"
End With
tdf.Indexes.Append idx

.TableDefs.Append tdf

End With

'Cant add a relationship as the StockGroups table is a link from

another

DB
'Call AddDAORelationship(dbBIDS, "Stock Groups",
"tblStockGroupDiscount", "StockGroupId", "sgdi_txt_StockGroupID",
dbRelationUpdateCascade + dbRelationDeleteCascade)
End Function

=============================================== =

Private Function AddDAOField(tdf As dao.TableDef, StrName As String,

dbType

As dao.DataTypeEnum, Optional intLength As Integer = -1, Optional
intAttributes As Integer = -1) As dao.Field
Dim fld As dao.Field
Set fld = New dao.Field
With fld
.Name = StrName
.Type = dbType
If intLength 0 Then .Size = intLength
If intAttributes 0 Then .Attributes = intAttributes
End With

tdf.Fields.Append fld
Set fld = Nothing
End Function


Private Function Update_PopulateStockGroupDiscountTable()
'Populates tblStockGroupDiscount with data in text file
MaterialDiscountRate.txt
Dim objTextFile As New clsTextFile

... and for clsTextFile


Dim cmm As ADODB.Command
'Dim strFields As Variant
Dim strValues() As String

Dim rst As New ADODB.Recordset
rst.Open "select * from tblStockGroupDiscount", ADOConnection,

... and for ADOConnection



Valid connection to database



adOpenKeyset, adLockOptimistic

With objTextFile
.OpenFile "MaterialDiscountRate.txt"
'MsgBox "Opened file"
While Not .EndOfFile
strValues = Split(.ReadFromFile, ",")
'MsgBox "Found " & strValues(0) & " in file"

rst.Filter = "sgdi_txt_StockGroupID='" & strValues(0) & "'"
If rst.EOF Then
'MsgBox "Adding " & strValues(0) & " in file"
rst.AddNew 'strFields, strValues
Else
'MsgBox "Updating " & strValues(0) & " in file"

End If

rst.Fields("sgdi_txt_StockGroupID") = strValues(0)
rst.Fields("sgdi_sgl_Discount") = strValues(1)
rst.Update
Wend
.CloseFile
rst.Close
End With

End Function



clsTextFile
===============
Option Explicit

Public Enum enuFileOpenMode
ForInput
ForOutput
ForAppend
End Enum

Private m_intFile As Integer

Public Sub OpenFile(strFileName As String, Optional FileOpenMode As
enuFileOpenMode = ForInput, Optional strDirectory As String = "")
'---------------------------------------------------------------------------
------------
' Procedure : OpenFile
' DateTime : 24/10/2005 10:26
' Author : tholland
' Purpose :
'---------------------------------------------------------------------------
------------
'
Dim booSucceed As Boolean
On Error GoTo OpenFile_Error

If strDirectory = "" Then
strDirectory = App.path & "\"
'strDirectory = Left$(strDirectory, InStrRev(strDirectory, "\"))
Else
strDirectory = Trim$(strDirectory)
If Right$(strDirectory, 1) "\" Then strDirectory = strDirectory & "\"
End If

strFileName = strDirectory & strFileName

m_intFile = FreeFile

Select Case FileOpenMode
Case ForInput
Open strFileName For Input As m_intFile

Case ForOutput
On Error Resume Next
Kill strFileName
On Error GoTo 0
Open strFileName For Output As m_intFile

Case ForAppend
Open strFileName For Append As m_intFile

End Select


OpenFile_Exit:
On Error Resume Next
Exit Sub

OpenFile_Error:
On Error Resume Next
Close m_intFile
Resume OpenFile_Exit
End Sub

Public Sub CloseFile()
Close m_intFile
End Sub

Public Sub WriteToFile(strText As String)
Print m_intFile, strText
End Sub

Public Function ReadFromFile() As String
Dim strRetVal As String

If Not EOF(m_intFile) Then
Line Input #m_intFile, strRetVal
End If

ReadFromFile = strRetVal
End Function

Public Function EndOfFile() As Boolean
EndOfFile = EOF(m_intFile)
End Function

Private Sub Class_Initialize()
On Error Resume Next
Close m_intFile

End Sub

no rush Vicent. The task that I needed to accomplish works even though the
data is 'invisible' But I would like to know what the problem is in case
I'm fooled in the future

Terry


"Vincent Johns" wrote in message
k.net...
Looks good -- I may be able to compile it with these changes. But not
right away; I'm out of time. I'll try to get to it this weekend. If
you need an answer sooner than that, you might try cleaning up the code
and re-posting your question with a new Subject: line, in hopes that
someone else might pick it up. In the meantime, I'll work on this
thread. (If you do solve it before I do, please let me know.)

-- Vincent Johns
Please feel free to quote anything I say here.

Terry Holland wrote:

See my notes below.

I realise that there is a mixture of DAO & ADO which is not ideal, but
this
is a legacy application that I want to modify as little as possible



Private Function ApplyUpdate_83()
ApplyUpdate 83, "2.0_29"


'ApplyUpdate 83, "2.0_29"
Not relevant so comment out


I need a definition for ApplyUpdate


Update_AddTableStockGroupDiscount
Update_PopulateStockGroupDiscountTable
Update_AddQueryApplyDiscountRates

... and for Update_AddQueryApplyDiscountRates


'Update_AddQueryApplyDiscountRates
also not relevant so comment out



End Function

=============================================== =

Private Function Update_AddTableStockGroupDiscount()
Dim tdf As dao.TableDef
Dim idx As dao.Index

If dbBIDS Is Nothing Then modDataBase.OpenBIDSDatabase

... and for dbBIDS and for modDataBase


dbBids is the variable of type DAO.Database that points to database and
modDataBase.OpenBIDSDatabase is a function that opens the database if it
is
not already open
ie

Module modDataBase
=====================
Global dbBIDS As DAO.Database

Public Sub OpenBIDSDatabase()

If dbBIDS Is Nothing Then
Set wsDefault = DBEngine.Workspaces(0)
Set dbBIDS =
wsDefault.OpenDatabase(g_objRegistrySettings.Conte stLocation)
End If

End Sub


'Check if table exists and exit function if it does
For Each tdf In dbBIDS.TableDefs
If tdf.Name = "tblStockGroupDiscount" Then
'dbBIDS.TableDefs.Delete (tdf.Name)
Exit Function
End If
Next

With dbBIDS
Set tdf = .CreateTableDef("tblStockGroupDiscount")

'Add fields to table
Call AddDAOField(tdf, "sgdi_lng_id", dbLong, , dbAutoIncrField)
Call AddDAOField(tdf, "sgdi_txt_StockGroupID", dbText, 6)
Call AddDAOField(tdf, "sgdi_sgl_Discount", dbSingle)

'create primary key
Set idx = tdf.CreateIndex("idxPKStockGroupDiscount")
With idx
.Primary = True
.Fields = "sgdi_lng_id"
End With
tdf.Indexes.Append idx

.TableDefs.Append tdf

End With

'Cant add a relationship as the StockGroups table is a link from

another

DB
'Call AddDAORelationship(dbBIDS, "Stock Groups",
"tblStockGroupDiscount", "StockGroupId", "sgdi_txt_StockGroupID",
dbRelationUpdateCascade + dbRelationDeleteCascade)
End Function

=============================================== =

Private Function AddDAOField(tdf As dao.TableDef, StrName As String,

dbType

As dao.DataTypeEnum, Optional intLength As Integer = -1, Optional
intAttributes As Integer = -1) As dao.Field
Dim fld As dao.Field
Set fld = New dao.Field
With fld
.Name = StrName
.Type = dbType
If intLength 0 Then .Size = intLength
If intAttributes 0 Then .Attributes = intAttributes
End With

tdf.Fields.Append fld
Set fld = Nothing
End Function


Private Function Update_PopulateStockGroupDiscountTable()
'Populates tblStockGroupDiscount with data in text file
MaterialDiscountRate.txt
Dim objTextFile As New clsTextFile

... and for clsTextFile


Dim cmm As ADODB.Command
'Dim strFields As Variant
Dim strValues() As String

Dim rst As New ADODB.Recordset
rst.Open "select * from tblStockGroupDiscount", ADOConnection,

... and for ADOConnection



Valid connection to database



adOpenKeyset, adLockOptimistic

With objTextFile
.OpenFile "MaterialDiscountRate.txt"
'MsgBox "Opened file"
While Not .EndOfFile
strValues = Split(.ReadFromFile, ",")
'MsgBox "Found " & strValues(0) & " in file"

rst.Filter = "sgdi_txt_StockGroupID='" & strValues(0) & "'"
If rst.EOF Then
'MsgBox "Adding " & strValues(0) & " in file"
rst.AddNew 'strFields, strValues
Else
'MsgBox "Updating " & strValues(0) & " in file"

End If

rst.Fields("sgdi_txt_StockGroupID") = strValues(0)
rst.Fields("sgdi_sgl_Discount") = strValues(1)
rst.Update
Wend
.CloseFile
rst.Close
End With

End Function



clsTextFile
===============
Option Explicit

Public Enum enuFileOpenMode
ForInput
ForOutput
ForAppend
End Enum

Private m_intFile As Integer

Public Sub OpenFile(strFileName As String, Optional FileOpenMode As
enuFileOpenMode = ForInput, Optional strDirectory As String = "")

'---------------------------------------------------------------------------
------------
' Procedure : OpenFile
' DateTime : 24/10/2005 10:26
' Author : tholland
' Purpose :

'---------------------------------------------------------------------------
------------
'
Dim booSucceed As Boolean
On Error GoTo OpenFile_Error

If strDirectory = "" Then
strDirectory = App.path & "\"
'strDirectory = Left$(strDirectory, InStrRev(strDirectory, "\"))
Else
strDirectory = Trim$(strDirectory)
If Right$(strDirectory, 1) "\" Then strDirectory = strDirectory &
"\"
End If

strFileName = strDirectory & strFileName

m_intFile = FreeFile

Select Case FileOpenMode
Case ForInput
Open strFileName For Input As m_intFile

Case ForOutput
On Error Resume Next
Kill strFileName
On Error GoTo 0
Open strFileName For Output As m_intFile

Case ForAppend
Open strFileName For Append As m_intFile

End Select


OpenFile_Exit:
On Error Resume Next
Exit Sub

OpenFile_Error:
On Error Resume Next
Close m_intFile
Resume OpenFile_Exit
End Sub

Public Sub CloseFile()
Close m_intFile
End Sub

Public Sub WriteToFile(strText As String)
Print m_intFile, strText
End Sub

Public Function ReadFromFile() As String
Dim strRetVal As String

If Not EOF(m_intFile) Then
Line Input #m_intFile, strRetVal
End If

ReadFromFile = strRetVal
End Function

Public Function EndOfFile() As Boolean
EndOfFile = EOF(m_intFile)
End Function

Private Sub Class_Initialize()
On Error Resume Next
Close m_intFile

End Sub

Hello,

To narrow down the issue, please create a new blank database and check if
you can reproduce the issue in the new database. If so, please package the
database file with winzip and send it to me for research. My email address
is .

Sophie Guo
Microsoft Online Partner Support

Get Secure! - www.microsoft.com/security

================================================== ===
When responding to posts, please "Reply to Group" via your newsreader so
that others may learn and benefit from your issue.
================================================== ===
This posting is provided "AS IS" with no warranties, and confers no rights.

To narrow down the issue, please create a new blank database and check if
you can reproduce the issue in the new database. If so, please package the
database file with winzip and send it to me for research.

I am unable to reproduce the problem in a new database.

Terry Holland wrote:

To narrow down the issue, please create a new blank database and check if
you can reproduce the issue in the new database. If so, please package the
database file with winzip and send it to me for research.


I am unable to reproduce the problem in a new database.

But I have now been able to reproduce it, in Access 2000. (I'll see if
it does the same thing in Access 2003, but not right now.)

Table [tblStockGroupDiscount] appears to be empty, as you noticed, but
the Query

SELECT [tblStockGroupDiscount].[sgdi_txt_StockGroupID],
[tblStockGroupDiscount].[sgdi_sgl_Discount]
FROM [Stock Groups] RIGHT JOIN tblStockGroupDiscount
ON [Stock Groups].[StockGroupId]
=[tblStockGroupDiscount].[sgdi_txt_StockGroupID];

displays all the records.

When I add a record in Table Datasheet View, only the added record is
visible, either in Table Datasheet View or via the Query

SELECT tblStockGroupDiscount.*
FROM tblStockGroupDiscount;

but all records are visible via the Query with the outer join.

If I copy the Table, all records are visible in the copy.

This behavior is consistent, I think, with what you say you observed. I
had to modify your code somewhat to run it on my system, but it runs
now, and I apparently made the same mistakes as you did. :-)

Now that I have a working copy to play with, I'll try playing with it...
something weird is going on. And for the benefit of anyone else who
wants to look at it, all of my code is posted below (module
[modDataBase] and class module [clsTextFile]). File "Holland.dsn"
contains an ODBC reference to the database in which the code runs.

-- Vincent Johns
Please feel free to quote anything I say here.


Code for [modDataBase]:


Option Compare Database
Option Explicit

Global dbBIDS As DAO.Database

'===================================
Private Function AddDAOField( _
tdf As DAO.TableDef, _
StrName As String, _
dbType As DAO.DataTypeEnum, _
Optional intLength As Integer = -1, _
Optional intAttributes As Integer = -1) _
As DAO.Field

Dim fld As DAO.Field

Set fld = New DAO.Field
With fld
.Name = StrName
.Type = dbType
If intLength 0 Then .Size = intLength
If intAttributes 0 Then _
.Attributes = intAttributes
End With 'fld

tdf.Fields.Append fld
Set fld = Nothing

End Function 'AddDAOField()

Public Function ApplyUpdate_83()
'ApplyUpdate 83, "2.0_29"

Update_AddTableStockGroupDiscount
Update_PopulateStockGroupDiscountTable
'Update_AddQueryApplyDiscountRates

End Function 'ApplyUpdate_83()

'===================================
'OpenBIDSDatabase is a function
' that opens the database if it is not
' already open ie
'
Public Sub OpenBIDSDatabase()
Dim wsDefault As Workspace '***added***

If dbBIDS Is Nothing Then

Set wsDefault = DBEngine.Workspaces(0)
Set dbBIDS = wsDefault.OpenDatabase( _
CurrentDb.Name)

'Set dbBIDS = wsDefault.OpenDatabase( _
g_objRegistrySettings.ContestLocation)

End If 'dbBIDS Is Nothing...

End Sub 'OpenBIDSDatabase()

'===================================
Private Function Update_AddTableStockGroupDiscount()

Dim tdf As DAO.TableDef
Dim idx As DAO.Index

If dbBIDS Is Nothing Then OpenBIDSDatabase

'dbBids is the variable of type DAO.Database _
that points to database

'Check if table exists and exit function if it does
For Each tdf In dbBIDS.TableDefs
If tdf.Name = "tblStockGroupDiscount" Then
dbBIDS.TableDefs.Delete (tdf.Name)
Exit Function
End If
Next

With dbBIDS
Set tdf = .CreateTableDef("tblStockGroupDiscount")

'Add fields to table
Call AddDAOField(tdf, "sgdi_lng_id", dbLong, , dbAutoIncrField)
Call AddDAOField(tdf, "sgdi_txt_StockGroupID", dbText, 6)
Call AddDAOField(tdf, "sgdi_sgl_Discount", dbSingle)

'create primary key
Set idx = tdf.CreateIndex("idxPKStockGroupDiscount")
With idx
.Primary = True
.Fields = "sgdi_lng_id"
End With
tdf.Indexes.Append idx

.TableDefs.Append tdf

.TableDefs.Refresh '***added***

End With

'Cant add a relationship as the StockGroups _
table is a link from another DB
'Call AddDAORelationship(dbBIDS, "Stock Groups", _
"tblStockGroupDiscount", "StockGroupId", _
"sgdi_txt_StockGroupID", _
dbRelationUpdateCascade + dbRelationDeleteCascade)

End Function 'Update_AddTableStockGroupDiscount()

'===================================
Private Function Update_PopulateStockGroupDiscountTable()
'Populates tblStockGroupDiscount with data
' in text file MaterialDiscountRate.txt

Dim objTextFile As New clsTextFile

Dim cmm As ADODB.Command
'Dim strFields As Variant
Dim strValues() As String
Dim ADOConnection As _
New ADODB.Connection
'Valid connection to database

Dim rst As New ADODB.Recordset

ADOConnection.Open _
"FileDSN=" _
& CurDir & "\Holland.dsn;"

rst.Open "select * from tblStockGroupDiscount", _
ADOConnection, _
adOpenKeyset, _
adLockOptimistic

With objTextFile
.OpenFile "MaterialDiscountRate.txt"
MsgBox "Opened file"

While Not .EndOfFile
strValues = Split(.ReadFromFile, ",")
MsgBox "Found " & strValues(0) & " in file"

rst.Filter = "sgdi_txt_StockGroupID='" _
& strValues(0) & "'"
If rst.EOF Then
MsgBox "Adding " & strValues(0) & " in file"
rst.AddNew 'strFields, strValues
Else
MsgBox "Updating " & strValues(0) & " in file"

End If

rst.Fields("sgdi_txt_StockGroupID") = _
strValues(0)
rst.Fields("sgdi_sgl_Discount") = _
strValues(1)
rst.Update
Wend 'Not .EndOfFile

.CloseFile
rst.Close
End With 'objTextFile

End Function 'Update_PopulateStockGroupDiscountTable()


Code for [clsTextFile]:

'===================================
'clsTextFile
'===============
Option Compare Database
Option Explicit

Public Enum enuFileOpenMode
ForInput
ForOutput
ForAppend
End Enum

Private m_intFile As Integer

'===================================
Public Sub CloseFile()
Close m_intFile
End Sub 'CloseFile()

'===================================
Public Function EndOfFile() As Boolean
EndOfFile = EOF(m_intFile)
End Function 'EndOfFile()

'-------------------------------
' Procedure : OpenFile
' DateTime : 24/10/2005 10:26
' Author : tholland
' Purpose :
'-------------------------------
'
Public Sub OpenFile( _
strFileName As String, _
Optional FileOpenMode As enuFileOpenMode _
= ForInput, _
Optional strDirectory As String = "")

Dim booSucceed As Boolean
On Error GoTo OpenFile_Error

If strDirectory = "" Then
strDirectory = CurDir & "\" '***changed***
'strDirectory = App.Path & "\"
strDirectory = Left$(strDirectory, _
InStrRev(strDirectory, "\"))
Else
strDirectory = Trim$(strDirectory)
If Right$(strDirectory, 1) "\" Then _
strDirectory = strDirectory & "\"

End If 'strDirectory =...

strFileName = strDirectory & strFileName

m_intFile = FreeFile

Select Case FileOpenMode
Case ForInput
Open strFileName For Input As m_intFile

Case ForOutput
On Error Resume Next
Kill strFileName
On Error GoTo 0
Open strFileName For Output As m_intFile

Case ForAppend
Open strFileName For Append As m_intFile

End Select 'Case FileOpenMode


OpenFile_Exit:
On Error Resume Next
Exit Sub

OpenFile_Error:
On Error Resume Next
Close m_intFile
Resume OpenFile_Exit

End Sub 'OpenFile()

'===================================
Public Function ReadFromFile() As String
Dim strRetVal As String

If Not EOF(m_intFile) Then
Line Input #m_intFile, strRetVal
End If

ReadFromFile = strRetVal
End Function 'ReadFromFile()

'===================================
Public Sub WriteToFile(strText As String)
Print m_intFile, strText
End Sub 'WriteToFile()

'===================================
Private Sub Class_Initialize()
On Error Resume Next
Close m_intFile

End Sub 'Class_Initialize()

Hello,

I have tested the issue on my side and I didn't reproduce the issue. The
possbile cause is database corruption. I suggest that you create a new
blank database and export data to the new database to resolve the issue.
You can refer to the following article:

How to troubleshoot and to repair a damaged Access 2002 or later database
http://support.microsoft.com/kb/283849/

Sophie Guo
Microsoft Online Partner Support

Get Secure! - www.microsoft.com/security

================================================== ===
When responding to posts, please "Reply to Group" via your newsreader so
that others may learn and benefit from your issue.
================================================== ===
This posting is provided "AS IS" with no warranties, and confers no rights.

Sophie Guo [MSFT] wrote:

Hello,

I have tested the issue on my side and I didn't reproduce the issue. The
possbile cause is database corruption. I suggest that you create a new
blank database and export data to the new database to resolve the issue.

Yes, that had occurred to me... but bear in mind that I *did* start with
a blank database in this case, and there were *no* data involved (except
for the values that I added after the Table was generated). So it looks
like more than just random corruption here. After adding 1 record in
Table Datasheet View, the record count of the original Table was 1.
Copying it produced a Table with a record count of 4, including the 3
records that I had constructed from data read from the text file.

Oh, yes, I posted my code (revised version of the OP's code) but not the
data. Here are the contents of the file [MaterialDiscountRate.txt] with
which I populated the [tblStockGroupDiscount] Table:

Group1, 5
Group2, 3
Grp 42, 42

I also defined a [Stock Groups] Table with these contents:
StockGroupId
------------
Group1
Group2
Grp 42

I don't know what kind of data the OP has.

You can refer to the following article:

How to troubleshoot and to repair a damaged Access 2002 or later database
http://support.microsoft.com/kb/283849/

Thank you; I used instead the Access 2000 version of that, at
http://support.microsoft.com/kb/209137/.

This article suggests compacting & repairing the database. As I expect
you can imagine, I had already done that (multiple times), with no
noticeable effect on the weird Table.

The article suggests exporting the Table contents to a text file. I had
not done that, but I have now, and I'll give you 3 guesses how many of
the 4 records wound up in the text file.

The article suggests trashing the database and reverting to a backup; it
also suggests that one 'post a message in the Microsoft Access "Third
Party and User Groups" Internet newsgroup' -- since the missing records
appear when the Table is copied, we probably aren't driven to these
desperate measures just yet.

I looked at "Typical Causes of .mdb File Corruption", and none of these
apply in this case -- it was an empty database, in which I ran some code
to import text from a file, and in which I then manually appended a
record in Table Datasheet View to the same Table.

One suggestion in the article that may be relevant is "When programming,
close all DAO objects and ADO objects that you have open." I haven't
checked the code closely, just made the minimal changes needed to get it
to run. (In my own programs I usually include much more error-checking
code and try to dispose of each object in the same procedure in which it
was created.) In this case, whatever is wrong has survived multiple
power-off-and-reboot operations, so that makes it kind of intriguing.
Anyway, that's likely what I'll look at next, as well as playing with
the db using Access 2003.

Incidentally, if you (or anyone else) would like a copy of my
stripped-down version of the database, containing the goofy Table plus
two others, two Queries, no Forms, no Reports, no Pages, and some code,
I can email you a copy (ZIP file of about 26 KB), but it may be more
informative to reproduce the problem as I did, if you can.

-- Vincent Johns
Please feel free to quote anything I say here.


Sophie Guo
Microsoft Online Partner Support

Get Secure! - www.microsoft.com/security

================================================== ===
When responding to posts, please "Reply to Group" via your newsreader so
that others may learn and benefit from your issue.
================================================== ===
This posting is provided "AS IS" with no warranties, and confers no rights.