Help to append flat file table to two tables

[Victoriya F via AccessMonster.com]

Hello,

Can anyone help me with this problem? I need to append a flat table to two
tables. I have two tables Observations and ObservationsB that are set up to
one-to-many relationship, and one FlatTable that has all the data that I need
to append to tables Observations and ObservationsB.

Table Observations:
Table ObservationsB
Table FlatTable
ObservationNumber
Transect
Station
Time
EndTime
ObsCode
Date
Cloud
Rain
Wind
Gust
P1
P2
P3
P4
P5
P6
P7
P8
P9
P10
Comments

Table ObservationsB:
ObservationBNumber
ObservationNumber
AlphaCode
Distance
Detection

Table FlatFile:
Transect
Station
Time
EndTime
ObsCode
Date
Cloud
Rain
Wind
Gust
P1
P2
P3
P4
P5
P6
P7
P8
P9
P10
AlphaCode
Distance
Detection
Comments


From table FlatFile I need to append fields: Transect, Station, Time, EndTime,
ObsCode, Date, Cloud, Rain, Wind, Gust, P1, P2, P3, P4, P5, P6, P7, P8, P9,
P10, Comments to table Observations and fields: AlphaCode, Distance, and
Detection to table ObservationsB.

I have an append query that appends records from FlatTable to table
Observations without any problem. When I create and run append query to
append records from FlatTable to ObservationsB I get an error message and not
able to append. The problem comes that two tables Observations and
ObservationsB are set up to one-to-many relationships. For example, Station
from table Observations has 10 AlphaCode from table ObservationsB.

Is there any way I can append data from FlatTable to tables Observations and
ObservationsB? I would really appreciate any help and ideas.



Thank you

 

[[MVP] S.Clark]

You may need to remove validations, relationships, or other constraints
prior to executing the query. Then turn it all on after after. Post your
error messages, as that may shed some light, too.

--
Steve Clark, Access MVP
FMS, Inc.
Call us for all of your Access Development Needs!
1-888-220-6234
(e-mail address removed)
www.fmsinc.com/consulting

 

[Vika]

Hi Steve

I deleted relationship between tables and appended both tables withou
any problem. However, when I tried to recreate relationship, I got a
error message: Can’t create this relationship and enforce referentia
integrity. Data in the table “Observationsb” violates referentia
integrity rules
Right now I have 123 records in table Observations and 2,489 record
in table Observationsb(it has to be set one-to-many relationship

thanks

Vik

 

[SteveS]

Hi Steve,

I deleted relationship between tables and appended both tables without
any problem. However, when I tried to recreate relationship, I got an
error message: Can�t create this relationship and enforce referential
integrity. Data in the table �Observationsb� violates referential
integrity rules.
Right now I have 123 records in table Observations and 2,489 records
in table Observationsb(it has to be set one-to-many relationship)


thanks,

Vika

Hi Vika,

If I understand right, you have

the one the many
Observations -----> Observationsb

What is/are the linking field(s) between the two tables?
What is the primary key for table Observations?

What is the primary key for table ObservationsB?

BTW, Date and Time are reserved words in Access and are poor choices for object
names (fields, forms, reports, etc). Maybe begTime would be better a better
name for the time field and obsvDate for the Date field.


To link the two tables, the primary key field(s) from table Observations must
be stored in (a) field(s) called a (foreign key) in table ObservationsB.

I would run an append query to append unique (distinct) records from table
FlatFile to table Observations. (Could be done in code instead)

Then (using code),I would open three recordsets based on the three tables.

For each record in recordset Observations, open a recordset from table flatfile
that selects matching records. Loop thru the flatfile recordset, adding a new
record to the ObservationsB recordset: the Observations recordset PK,
AlphaCode, Distance, and Detection.

The code below is air code but should be close; I didn't know the field types -
I guessed. You'll have to edit the code.....
(watch for line wrap)

'*****************************Option Compare Database
Option Explicit

Public Sub SplitFlatFile()
Dim strSQL As String
Dim strObsvSQL As String
Dim strFF_SQL As String
Dim rstObsv As Recordset
Dim rstObsvB As Recordset
Dim rstFlatFile As Recordset

' temp variables
Dim vP1 As Long, vP2 As Long, vP3 As Long, vP4 As Long, vP5 As Long
Dim vP6 As Long, vP7 As Long, vP8 As Long, vP9 As Long, vP10 As Long
Dim vGust As String, vWind As String, vRain As String, vCloud As String
Dim vObsCode As String, vStation As String, vTransect As Long
Dim vobsvDate As Date, vbegTime As Date, vEndTime As Date


' delete records from tables Observations & ObservationsB
CurrentDb.Execute "Delete * from ObservationsB", dbFailOnError
CurrentDb.Execute "Delete * from Observations", dbFailOnError

' this selects unique records
strSQL = "INSERT INTO Observations ( Transect, Station, begTime, EndTime,"
strSQL = strSQL & " ObsCode, obsvDate, Cloud, Rain, Wind, Gust, P1, P2, P3,"
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, Comments )"
strSQL = strSQL & " SELECT DISTINCT Transect, Station, begTime, EndTime,"
strSQL = strSQL & " ObsCode, obsvDate, Cloud, Rain, Wind, Gust, P1, P2, P3,"
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, Comments"
strSQL = strSQL & " FROM FlatFile;"

' append records from FlatFile to table Observations
CurrentDb.Execute strSQL, dbFailOnError

'records are now in table Observations/ create a recordset
strObsvSQL = "SELECT ID, Transect, Station, begTime, EndTime,"
strObsvSQL = strObsvSQL & " ObsCode, obsvDate, Cloud, Rain, Wind, Gust, P1,
P2, P3,"
strObsvSQL = strObsvSQL & " P4, P5, P6, P7, P8, P9, P10"
strObsvSQL = strObsvSQL & " FROM Observations Order by P10;"

'outer loop
Set rstObsv = CurrentDb.OpenRecordset(strObsvSQL)
If (rstObsv.BOF And rstObsv.EOF) Then
rstObsv.Close
Set rstObsv = Nothing
MsgBox "No records in table Observations. Aborting!"
Exit Sub
End If

'
Set rstObsvB = CurrentDb.OpenRecordset("ObservationsB")

With rstObsv
.MoveFirst
Do While Not .EOF
vP1 = !P1
vP2 = !P2
vP3 = !P3
vP4 = !P4
vP5 = !P5
vP6 = !P6
vP7 = !P7
vP8 = !P8
vP9 = !P9
vP10 = !P10
vGust = !Gust
vWind = !Wind
vRain = !Rain
vCloud = !Cloud
vObsCode = !ObsCode
vStation = !Station
vTransect = !Transect
vobsvDate = !obsvDate
vbegTime = !begTime
vEndTime = !EndTime

strFF_SQL = "SELECT FlatFile.AlphaCode, FlatFile.Distance,
FlatFile.Detection, FlatFile.P10"
strFF_SQL = strFF_SQL & " FROM FlatFile Where"
strFF_SQL = strFF_SQL & " FlatFile.P10 = " & vP10
strFF_SQL = strFF_SQL & " AND FlatFile.P9 = " & vP9
strFF_SQL = strFF_SQL & " And FlatFile.P8 = " & vP8
strFF_SQL = strFF_SQL & " AND FlatFile.P7 = " & vP7
strFF_SQL = strFF_SQL & " AND FlatFile.P6 = " & vP6
strFF_SQL = strFF_SQL & " AND FlatFile.P5 = " & vP5
strFF_SQL = strFF_SQL & " AND FlatFile.P4 = " & vP4
strFF_SQL = strFF_SQL & " AND FlatFile.P3 = " & vP3
strFF_SQL = strFF_SQL & " AND FlatFile.P2 = " & vP2
strFF_SQL = strFF_SQL & " AND FlatFile.P1 = " & vP1
strFF_SQL = strFF_SQL & " AND FlatFile.Gust = '" & vGust & "'"
strFF_SQL = strFF_SQL & " AND FlatFile.Wind = '" & vWind & "'"
strFF_SQL = strFF_SQL & " AND FlatFile.Rain = '" & vRain & "'"
strFF_SQL = strFF_SQL & " AND FlatFile.Cloud = '" & vCloud & "'"
strFF_SQL = strFF_SQL & " AND FlatFile.ObsCode = '" & vObsCode & "'"
strFF_SQL = strFF_SQL & " AND FlatFile.obsvDate = #" & vobsvDate & "#"
strFF_SQL = strFF_SQL & " AND FlatFile.EndTime = #" & vEndTime & "#"
strFF_SQL = strFF_SQL & " AND FlatFile.begTime = #" & vbegTime & "#"
strFF_SQL = strFF_SQL & " AND FlatFile.Station = '" & vStation & "'"
strFF_SQL = strFF_SQL & " AND FlatFile.Transect = " & vTransect & ";"
'Debug.Print strFF_SQL


Set rstFlatFile = CurrentDb.OpenRecordset(strFF_SQL)
With rstFlatFile
.MoveFirst
'inner loop
Do While Not .EOF
'add records to table ObservationsB
With rstObsvB
.AddNew
!P10 = rstFlatFile("P10")
!AlphaCode = rstFlatFile("AlphaCode")
!Distance = rstFlatFile("Distance")
!Detection = rstFlatFile("Detection")
!FK = rstObsv("ID")
.Update
End With
' move to next rstFlatFile record
.MoveNext
Loop
.Close
End With
.MoveNext
Loop
End With



rstObsv.Close
rstObsvB.Close

Set rstObsv = Nothing
Set rstObsvB = Nothing
Set rstFlatFile = Nothing

End Sub
'*****************


HTH

 

[Vika]

Hi Steve 2

Thank you so much for your help... I really appreciate it. I will b
back to my office tomorrow and will give it a try

Thank you again

Vik

P.S. Tables Observation and Obserbationb are linked together o
OnbservationNumber field (which is Auto Number

 

[SteveS]

Hi Steve 2

Thank you so much for your help... I really appreciate it. I will be
back to my office tomorrow and will give it a try.


Thank you again,

Vika

P.S. Tables Observation and Obserbationb are linked together on
OnbservationNumber field (which is Auto Number)

Vika,

Try this on a backup (copy) of your database until it is working!!!

The code will not work for you as written. There are some fields I didn't use
(like ObservationNumber) because I didn't know what the field was, what fields
linked the tables and I didn't know the field types; when I made my tables I
guessed at the field types. The code *does* work for the tables I made - and
should for you after you modify it.

When you modify the SQL string "strFF_SQL", remember that numeric fields do not
require delimiters, strings need (I use) single quotes and dates need "#" symbols.

If you have questions, post back.

Good luck

 

[Vika]

Hi Steve

I modified your code and tried it this way

Private Sub Command1_Click(

Dim strSQL As Strin
Dim strObsvSQL As Strin
Dim strFF_SQL As Strin
Dim rstObsv As Recordse
Dim rstObsvB As Recordse
Dim rstFlatTable As Recordse

' temp variable
Dim vP1 As Double, vP2 As Double, vP3 As Double, vP4 As Double, vP5 A
Doubl
Dim vP6 As Double, vP7 As Double, vP8 As Double, vP9 As Double, vP1
A
Doubl
Dim vGust As Long, vWind As Long, vRain As Long, vCloud As Lon
Dim vObsCode As String, vStation As Long, vTransect As Strin
Dim vobsvDate As Date, vBegTime As Long, vEndTime As Lon

' delete records from tables Observations & Observations
CurrentDb.Execute "Delete * from Observationsb", dbFailOnErro
CurrentDb.Execute "Delete * from Observations", dbFailOnErro

' this selects unique record
strSQL = "INSERT INTO Observations ( TRANSECT, STATION, BEGTIME
ENDTIME,
strSQL = strSQL & " OBSCODE, OBSVDATE, CLOUD, RAIN, WIND, GUST
P1, P2, P3,
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, COMMENTS )
strSQL = strSQL & " SELECT DISTINCT TRANSECT, STATION, BEGTIME
ENDTIME,
strSQL = strSQL & " OBSCODE, OBSVDATE, CLOUD, RAIN, WIND, GUST
P1, P2, P3,
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, COMMENTS
strSQL = strSQL & " FROM FlatTable;

' append records from FlatTable to table Observation
CurrentDb.Execute strSQL, dbFailOnErro

'records are now in table Observations/ create a recordse
strObsvSQL = "SELECT ObservationNumber, TRANSECT, STATION, BEGTIME
ENDTIME,
strObsvSQL = strObsvSQL & " OBSCODE, OBSVDATE, CLOUD, RAIN, WIND
GUST
P1, P2 , P3,
strObsvSQL = strObsvSQL & " P4, P5, P6, P7, P8, P9, P10
strObsvSQL = strObsvSQL & " FROM Observations Order by TRANSECT;

'outer loo
Set rstObsv = CurrentDb.OpenRecordset(strObsvSQL
If (rstObsv.BOF And rstObsv.EOF) The
rstObsv.Clos
Set rstObsv = Nothin
MsgBox "No records in table Observations. Aborting!
Exit Su
End I


Set rstObsvB = CurrentDb.OpenRecordset("Observationsb"

With rstObs
.MoveFirs
Do While Not .EO
vP1 = !P
vP2 = !P
vP3 = !P
vP4 = !P
vP5 = !P
vP6 = !P
vP7 = !P
vP8 = !P
vP9 = !P
vP10 = !P1
vGust = !GUS
vWind = !WIN
vRain = !RAI
vCloud = !CLOU
vObsCode = !OBSCOD
vStation = !STATIO
vTransect = !TRANSEC
vobsvDate = !obsvDat
vBegTime = !begTim
vEndTime = !ENDTIM

strFF_SQL = "SELECT FlatTable.AlphaCode, FlatTable.Distance
FlatTable.Detection, FlatTable.TRANSECT
strFF_SQL = strFF_SQL & " FROM FlatTable Where
strFF_SQL = strFF_SQL & " FlatTable.P10 = " & vP1
strFF_SQL = strFF_SQL & " AND FlatTable.P9 = " & vP
strFF_SQL = strFF_SQL & " And FlatTable.P8 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.P7 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.P6 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.P5 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.P4 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.P3 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.P2 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.P1 = " & vP
strFF_SQL = strFF_SQL & " AND FlatTable.GUST = '" & vGus
& "'
strFF_SQL = strFF_SQL & " AND FlatTable.WIND = '" & vWin
& "'
strFF_SQL = strFF_SQL & " AND FlatTable.RAIN = '" & vRai
& "'
strFF_SQL = strFF_SQL & " AND FlatTable.CLOUD = '" & vClou
& "'
strFF_SQL = strFF_SQL & " AND FlatTable.OBSCODE = '"
vObsCode & "'
strFF_SQL = strFF_SQL & " AND FlatTable.OBSVDATE = #"
vobsvDate & "#
strFF_SQL = strFF_SQL & " AND FlatTable.ENDTIME = #"
vEndTime & "#
strFF_SQL = strFF_SQL & " AND FlatTable.BEGTIME = #"
vBegTime & "#
strFF_SQL = strFF_SQL & " AND FlatTable.STATION = '"
vStation & "'
strFF_SQL = strFF_SQL & " AND FlatTable.TRANSECT = "
vTransect & ";
'Debug.Print strFF_SQ

Set rstFlatTable = CurrentDb.OpenRecordset(strFF_SQL
With rstFlatTabl
.MoveFirs
'inner loo
Do While Not .EO
'add records to table Observations
With rstObsv
.AddNe
!TRANSECT = rstFlatTable("TRANSECT"
!ALPHACODE = rstFlatTable("ALPHACODE"
!DISTANCE = rstFlatTable("DISTANCE"
!DETECTION = rstFlatTable("DETECTION"
!ObservationNumber = rstObsv("ObservationNumber"
.Updat
End Wit
' move to next rstFlatTable recor
.MoveNext
Loop
.Close
End With
.MoveNext
Loop
End With



rstObsv.Close
rstObsvB.Close

Set rstObsv = Nothing
Set rstObsvB = Nothing
Set rstFlatTable = Nothing

End Sub

However, when I run the code, I get an error message “Type mismatched”
on Set rstObsv = CurrentDb.OpenRecordset(strObsvSQL)
I can’t figure out where is the problem exactly. Maybe the Auto Number
causing it?

Thanks,

Vika

 

[SteveS]

Hi Steve,

I modified your code and tried it this way:

Private Sub Command1_Click()

Dim strSQL As String
Dim strObsvSQL As String
Dim strFF_SQL As String
Dim rstObsv As Recordset
Dim rstObsvB As Recordset
Dim rstFlatTable As Recordset

' temp variables
Dim vP1 As Double, vP2 As Double, vP3 As Double, vP4 As Double, vP5 As
Double
Dim vP6 As Double, vP7 As Double, vP8 As Double, vP9 As Double, vP10
As
Double
Dim vGust As Long, vWind As Long, vRain As Long, vCloud As Long
Dim vObsCode As String, vStation As Long, vTransect As String
Dim vobsvDate As Date, vBegTime As Long, vEndTime As Long


' delete records from tables Observations & Observationsb
CurrentDb.Execute "Delete * from Observationsb", dbFailOnError
CurrentDb.Execute "Delete * from Observations", dbFailOnError

' this selects unique records
strSQL = "INSERT INTO Observations ( TRANSECT, STATION, BEGTIME,
ENDTIME,"
strSQL = strSQL & " OBSCODE, OBSVDATE, CLOUD, RAIN, WIND, GUST,
P1, P2, P3,"
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, COMMENTS )"
strSQL = strSQL & " SELECT DISTINCT TRANSECT, STATION, BEGTIME,
ENDTIME,"
strSQL = strSQL & " OBSCODE, OBSVDATE, CLOUD, RAIN, WIND, GUST,
P1, P2, P3,"
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, COMMENTS"
strSQL = strSQL & " FROM FlatTable;"

' append records from FlatTable to table Observations
CurrentDb.Execute strSQL, dbFailOnError

'records are now in table Observations/ create a recordset
strObsvSQL = "SELECT ObservationNumber, TRANSECT, STATION, BEGTIME,
ENDTIME,"
strObsvSQL = strObsvSQL & " OBSCODE, OBSVDATE, CLOUD, RAIN, WIND,
GUST,
P1, P2 , P3, "
strObsvSQL = strObsvSQL & " P4, P5, P6, P7, P8, P9, P10"
strObsvSQL = strObsvSQL & " FROM Observations Order by TRANSECT;"

'outer loop
Set rstObsv = CurrentDb.OpenRecordset(strObsvSQL)
If (rstObsv.BOF And rstObsv.EOF) Then
rstObsv.Close
Set rstObsv = Nothing
MsgBox "No records in table Observations. Aborting!"
Exit Sub
End If

'
Set rstObsvB = CurrentDb.OpenRecordset("Observationsb")

With rstObsv
MoveFirst
Do While Not .EOF
vP1 = !P1
vP2 = !P2
vP3 = !P3
vP4 = !P4
vP5 = !P5
vP6 = !P6
vP7 = !P7
vP8 = !P8
vP9 = !P9
vP10 = !P10
vGust = !GUST
vWind = !WIND
vRain = !RAIN
vCloud = !CLOUD
vObsCode = !OBSCODE
vStation = !STATION
vTransect = !TRANSECT
vobsvDate = !obsvDate
vBegTime = !begTime
vEndTime = !ENDTIME

strFF_SQL = "SELECT FlatTable.AlphaCode, FlatTable.Distance,
FlatTable.Detection, FlatTable.TRANSECT"
strFF_SQL = strFF_SQL & " FROM FlatTable Where"
strFF_SQL = strFF_SQL & " FlatTable.P10 = " & vP10
strFF_SQL = strFF_SQL & " AND FlatTable.P9 = " & vP9
strFF_SQL = strFF_SQL & " And FlatTable.P8 = " & vP8
strFF_SQL = strFF_SQL & " AND FlatTable.P7 = " & vP7
strFF_SQL = strFF_SQL & " AND FlatTable.P6 = " & vP6
strFF_SQL = strFF_SQL & " AND FlatTable.P5 = " & vP5
strFF_SQL = strFF_SQL & " AND FlatTable.P4 = " & vP4
strFF_SQL = strFF_SQL & " AND FlatTable.P3 = " & vP3
strFF_SQL = strFF_SQL & " AND FlatTable.P2 = " & vP2
strFF_SQL = strFF_SQL & " AND FlatTable.P1 = " & vP1
strFF_SQL = strFF_SQL & " AND FlatTable.GUST = '" & vGust
& "'"
strFF_SQL = strFF_SQL & " AND FlatTable.WIND = '" & vWind
& "'"
strFF_SQL = strFF_SQL & " AND FlatTable.RAIN = '" & vRain
& "'"
strFF_SQL = strFF_SQL & " AND FlatTable.CLOUD = '" & vCloud
& "'"
strFF_SQL = strFF_SQL & " AND FlatTable.OBSCODE = '" &
vObsCode & "'"
strFF_SQL = strFF_SQL & " AND FlatTable.OBSVDATE = #" &
vobsvDate & "#"
strFF_SQL = strFF_SQL & " AND FlatTable.ENDTIME = #" &
vEndTime & "#"
strFF_SQL = strFF_SQL & " AND FlatTable.BEGTIME = #" &
vBegTime & "#"
strFF_SQL = strFF_SQL & " AND FlatTable.STATION = '" &
vStation & "'"
strFF_SQL = strFF_SQL & " AND FlatTable.TRANSECT = " &
vTransect & ";"
'Debug.Print strFF_SQL


Set rstFlatTable = CurrentDb.OpenRecordset(strFF_SQL)
With rstFlatTable
MoveFirst
'inner loop
Do While Not .EOF
'add records to table Observationsb
With rstObsvB
AddNew
!TRANSECT = rstFlatTable("TRANSECT")
!ALPHACODE = rstFlatTable("ALPHACODE")
!DISTANCE = rstFlatTable("DISTANCE")
!DETECTION = rstFlatTable("DETECTION")
!ObservationNumber = rstObsv("ObservationNumber")
Update
End With
' move to next rstFlatTable record
MoveNext
Loop
Close
End With
MoveNext
Loop
End With



rstObsv.Close
rstObsvB.Close

Set rstObsv = Nothing
Set rstObsvB = Nothing
Set rstFlatTable = Nothing

End Sub

However, when I run the code, I get an error message �Type mismatched�
on Set rstObsv = CurrentDb.OpenRecordset(strObsvSQL)
I can�t figure out where is the problem exactly. Maybe the Auto Number
causing it?

Thanks,

Vika

"Type Mismatch" usually means that you are trying to put the wrong type data
into a field/variable.

Under the comment "temp variables", you changed BEGTIME and ENDTIME from
Date type to a Long. In "FlatTable" and "Observations", what are fields
BEGTIME and ENDTIME types?


Also, you are missing a period (.) in 5 places: in front of MoveFirst, AddNew,
Update, MoveNext & MoveNext.

It has to be .MoveFirst, .AddNew, .Update, .MoveNext, .MoveNext.



In table Observations, do you have an autonumber field? If so, what is the name?

Same question for table ObservationsB.



Here is an easy way to document your fields to a text file. Create a new MODULE
and paste in the following code. Then put the cursor on the "SUB doctable()"
line and press the F5 key.

A text file named "fieldtype.txt" in MyDocuments (I think). Post the results

'**** begcode*****
Public Sub doctable()
Dim fld As Field
Dim tbl As TableDef
Dim fieldtype As Integer
Dim db As Database

On Error GoTo error_Print
Set db = CurrentDb
fieldtype = FreeFile()

Open "fieldtype.txt" For Output As #fieldtype

For Each tbl In db.TableDefs
If Not Left(tbl.Name, 4) = "MSys" Then
If tbl.Name = "FlatTable" Or _
tbl.Name = "Observations" Or _
tbl.Name = "Observationsb" Then
Print #fieldtype, tbl.Name & ":"
For Each fld In tbl.Fields
Print #fieldtype, fld.Name; "/"; basFieldType(fld.Type); "/";
fld.Size
Next fld
Print #fieldtype,
Print #fieldtype,
End If
End If
Next tbl
Close #fieldtype

Exit Sub

error_Print:
MsgBox Err.Number & " - " & Err.Description
Close #fieldtype

End Sub

'------------------------------------------------------

Function basFieldType(intType As Integer) As String

Select Case intType
Case dbBoolean
basFieldType = "Boolean"
Case dbByte
basFieldType = "Byte"
Case dbInteger
basFieldType = "Integer"
Case dbLong
basFieldType = "Long Integer"
Case dbCurrency
basFieldType = "Currency"
Case dbSingle
basFieldType = "Single"
Case dbDouble
basFieldType = "Double"
Case dbDate
basFieldType = "Date"
Case dbText
basFieldType = "Text"
Case dbLongBinary
basFieldType = "LongBinary"
Case dbMemo
basFieldType = "Memo"
Case dbGUID
basFieldType = "GUID"
End Select

End Function

'**** endcode*****

 

[Vika]

Hi Steve

BEGTIME and ENDTIME are Long Integers in the table FlatTable and tabl
Observations. In the table Observation autonumber field i
ObservationNumber. In table Observationsb the field ObservationNumbe
is set to Number(long integer). The autonumber filed in th
Observationsb table is ObservationBNumber

I followed you instructions, created new module and pasted your code
When I run it, I got a message “13-Type mismatched”. In the fil
fieldtype.txt I can see only one field “FlatTable:”

I manually documented all the fields in the table

Table FlatTabl

TRANSECT (TEXT,50
STATION (NUMBER, LONG INTEGER
OBSCODE (TEXT,4
OBSVDATE (DATE/TIME
BEGTIME (NUMBER, LONG INTEGER
ENDTIME (NUMBER, LONG INTEGER
CLOUD (NUMBER, LONG INTEGER
RAIN (NUMBER, LONG INTEGER
WIND (NUMBER, LONG INTEGER
GUST (NUMBER, LONG INTEGER
P1 (NUMBER, DOUBLE
P2 (NUMBER, DOUBLE
P3 (NUMBER, DOUBLE
P4 (NUMBER, DOUBLE
P5 (NUMBER, DOUBLE
P6 (NUMBER, DOUBLE
P7 (NUMBER, DOUBLE
P8 (NUMBER, DOUBLE
P9 (NUMBER, DOUBLE
P10 (NUMBER, DOUBLE
DISTANCE (NUMBER, INTEGER
ALPHACODE (TEXT,4
DETECTION (NUMBER, LONG INTEGER
COMMENTS (MEMO

Table Observation

ObservationNumver (AutoNumber
TRANSECT (TEXT,50
STATION (NUMBER, LONG INTEGER
OBSCODE (TEXT,4
OBSVDATE (DATE/TIME
BEGTIME (NUMBER, LONG INTEGER
ENDTIME (NUMBER, LONG INTEGER
CLOUD (NUMBER, LONG INTEGER
RAIN (NUMBER, LONG INTEGER
WIND (NUMBER, LONG INTEGER
GUST (NUMBER, LONG INTEGER
P1 (NUMBER, DOUBLE
P2 (NUMBER, DOUBLE
P3 (NUMBER, DOUBLE
P4 (NUMBER, DOUBLE
P5 (NUMBER, DOUBLE
P6 (NUMBER, DOUBLE
P7 (NUMBER, DOUBLE
P8 (NUMBER, DOUBLE
P9 (NUMBER, DOUBLE
P10 (NUMBER, DOUBLE
COMMENTS (MEMO

Table Observations

ObservationBNumber(AutoNumber
ObservationNumber(Number, Long Integer
APHACODE (TEXT,4
DISTANCE (NUMBER, INTEGER
DETECTION (NUMBER, LONG INTEGER

Thanks

Vik

 

[SteveS]

OK Vika,

Hopefully this should work........

Here is the revised code. Watch for line wrap

'****BEG Code **********
Private Sub Command1_Click()
Dim strSQL As String
Dim strObsvSQL As String
Dim strFF_SQL As String
Dim rstObsv As Recordset
Dim rstObsvB As Recordset
Dim rstFlatTable As Recordset


' temp variables
Dim vP1 As Double, vP2 As Double, vP3 As Double, vP4 As Double, vP5 As
Double
Dim vP6 As Double, vP7 As Double, vP8 As Double, vP9 As Double, vP10 As
Double

Dim vGust As Long, vWind As Long, vRain As Long, vCloud As Long
Dim vStation As Long, vBegTime As Long, vEndTime As Long
Dim vObservationNumber As Long

Dim vObsCode As String, vTransect As String

Dim vobsvDate As Date

'for message box
Dim strMessage As String, Resp As Integer


' delete records from tables Observations & ObservationsB
CurrentDb.Execute "Delete * from ObservationsB", dbFailOnError
CurrentDb.Execute "Delete * from Observations", dbFailOnError


strSQL = "INSERT INTO Observations ( Transect, Station, BegTime, EndTime,"
strSQL = strSQL & " ObsCode, obsvDate, Cloud, Rain, Wind, Gust, P1, P2,
P3,"
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, Comments )"
strSQL = strSQL & " SELECT DISTINCT Transect, Station, begTime, EndTime,"
strSQL = strSQL & " ObsCode, obsvDate, Cloud, Rain, Wind, Gust, P1, P2,
P3,"
strSQL = strSQL & " P4, P5, P6, P7, P8, P9, P10, Comments"
strSQL = strSQL & " FROM FlatTable;"

' append records from FlatTable to table Observations
CurrentDb.Execute strSQL, dbFailOnError

'records are now in Observations/ create recordset
strObsvSQL = "SELECT ObservationNumber, Transect, Station, begTime,
EndTime,"
strObsvSQL = strObsvSQL & " ObsCode, obsvDate, Cloud, Rain, Wind, Gust,
P1, P2, P3,"
strObsvSQL = strObsvSQL & " P4, P5, P6, P7, P8, P9, P10"
strObsvSQL = strObsvSQL & " FROM Observations Order by ObservationNumber;"

'outer loop
Set rstObsv = CurrentDb.OpenRecordset(strObsvSQL)
If (rstObsv.BOF And rstObsv.EOF) Then
rstObsv.Close
Set rstObsv = Nothing
MsgBox "No records in table Observations. Aborting!"
Exit Sub
End If


Set rstObsvB = CurrentDb.OpenRecordset("ObservationsB")

With rstObsv
.MoveFirst
Do While Not .EOF
vObservationNumber = !ObservationNumber
vTransect = !Transect
vStation = !Station
vObsCode = !ObsCode
vobsvDate = !obsvDate
vBegTime = !begTime
vEndTime = !EndTime
vCloud = !Cloud
vRain = !Rain
vWind = !Wind
vGust = !Gust
vP1 = !P1
vP2 = !P2
vP3 = !P3
vP4 = !P4
vP5 = !P5
vP6 = !P6
vP7 = !P7
vP8 = !P8
vP9 = !P9
vP10 = !P10

strFF_SQL = "SELECT AlphaCode, Distance, Detection"
strFF_SQL = strFF_SQL & " FROM FlatTable Where"
strFF_SQL = strFF_SQL & " Transect = '" & vTransect & "'"
strFF_SQL = strFF_SQL & " AND Station = " & vStation
strFF_SQL = strFF_SQL & " AND ObsCode = '" & vObsCode & "'"
strFF_SQL = strFF_SQL & " AND obsvDate = #" & vobsvDate & "#"
strFF_SQL = strFF_SQL & " AND EndTime = " & vEndTime
strFF_SQL = strFF_SQL & " AND begTime = " & vBegTime
strFF_SQL = strFF_SQL & " AND Cloud = " & vCloud
strFF_SQL = strFF_SQL & " AND Rain = " & vRain
strFF_SQL = strFF_SQL & " AND Wind = " & vWind
strFF_SQL = strFF_SQL & " AND Gust = " & vGust
strFF_SQL = strFF_SQL & " AND P1 = " & vP1
strFF_SQL = strFF_SQL & " AND P2 = " & vP2
strFF_SQL = strFF_SQL & " AND P3 = " & vP3
strFF_SQL = strFF_SQL & " AND P4 = " & vP4
strFF_SQL = strFF_SQL & " AND P5 = " & vP5
strFF_SQL = strFF_SQL & " AND P6 = " & vP6
strFF_SQL = strFF_SQL & " AND P7 = " & vP7
strFF_SQL = strFF_SQL & " And P8 = " & vP8
strFF_SQL = strFF_SQL & " AND P9 = " & vP9
strFF_SQL = strFF_SQL & " AND P10 = " & vP10

'Debug.Print strFF_SQL

Set rstFlatTable = CurrentDb.OpenRecordset(strFF_SQL)
With rstFlatTable
.MoveFirst
'inner loop
Do While Not .EOF
'add records to table ObservationsB
With rstObsvB
.AddNew
!AlphaCode = rstFlatTable("AlphaCode")
!Distance = rstFlatTable("Distance")
!Detection = rstFlatTable("Detection")
!ObservationNumber = vObservationNumber
.Update
End With
' move to next rstFlatTable record
.MoveNext
Loop
.Close
End With
.MoveNext
Loop
End With



rstObsv.Close
rstObsvB.Close

Set rstObsv = Nothing
Set rstObsvB = Nothing
Set rstFlatTable = Nothing

' Tell me about the operations
strMessage = CurrentDb.TableDefs!Observations.RecordCount
strMessage = strMessage & " distinct records added to table Observations"
strMessage = strMessage & vbCrLf
strMessage = strMessage & vbCrLf
strMessage = strMessage & CurrentDb.TableDefs!ObservationsB.RecordCount
strMessage = strMessage & " records added to table ObservationsB"
strMessage = strMessage & vbCrLf
strMessage = strMessage & " from " &
CurrentDb.TableDefs!FlatTable.RecordCount
strMessage = strMessage & " records in table FlatTable"

Resp = MsgBox(strMessage, vbInformation + vbOKOnly, "Record Import")

End Sub
'****END Code **********

Let me know how it works. :-D

 

[Vika]

Hi Steve

Thumbs up!!!! Awesome!!! The code works great. The problem was in th
database itself. I had to recreate both tables Observations an
Observationsb, and now everything works great. You are a lif
saver I have so many surveys that I receive in a text file. Wit
your help now I can import everything into database

Million thanks….

Vik

 

[SteveS]

You're welcome!

Thanks for letting me know how things turned out. I was wondering if the
code was inserting the records right.