' The following is a list of the tables and field names that
'the module needs to place the data from the GEDCOM file into.

' The input file is named GEDCOM.GED.


'TableName       Name           Type            Length  IndexName

'FAMILY          Personnum      Integer         2       Personnum
'FAMILY          Family ID      Integer         2       Family ID
'FAMILY          Type           Text            50      
'FAMILY          Date of Event  Date/Time       8       
'FAMILY          Date           Text            50      
'FAMILY          Place          Text            50      
'FAMILY          Notes          Text            240     
'FAMILY          Spouse         Integer         2       Spouse
'Items           Personnum      Integer         2       Personnum
'Items           Item           OLE Object      0       
'Items           Source         Text            240     
'Items           Caption        Memo            0       
'personnal       Personnum      Integer         2       PrimaryKey
'personnal       Given Name     Text            240     
'personnal       Surname        Text            50      
'personnal       Sex            Text            1       
'personnal       Date of birth  Date/Time       8       
'personnal       Birth Date     Text            50      
'personnal       Birth Place    Text            50      
'personnal       Birth Info     Text            50      
'personnal       CF             Integer         2       
'personnal       Father         Integer         2       
'personnal       Mother         Integer         2       
'personnal       Occupation     Text            50      
'personnal       Immigration    Text            50      
'personnal       History        Memo            0       
'personnal       Obiturary Information   Memo   0       
'personnal       Death Date     Text            50      
'personnal       Death Place    Text            50      
'personnal       Death Info     Text            50      
'personnal       Burial Date    Text            50      
'personnal       Burial Place   Text            50      
'personnal       Burial Info    Text            50      
'personnal       Monument Info  Text            50      
'personnal       Picture        OLE Object      0       
'TblChildren     Parent         Integer         2       Parent
'TblChildren     Personnum      Integer         2       Personnum
'TblChildren     CF             Integer         2       
'TblChildren     Spouse         Integer         2 

Dim mydb As Database, MYTABLE As Table, FAMTABLE  As Table, CHILDTABLE As Table
Dim myquery As QueryDef
Dim FSTAMP, SNDAMP, PERSONNUM, CHILDNUM, HUSBNUM, WIFENUM, FAMNUM As Integer

Function readged ()
Set mydb = CurrentDB()
Set MYTABLE = mydb.OpenTable("personnal")
Set CHILDTABLE = mydb.OpenTable("TBLCHILDREN")
Set FAMTABLE = mydb.OpenTable("family")

MYTABLE.index = primarykey
FAMTABLE.index = primarykey
Set myquery = mydb.CreateQueryDef("add parents")
myquery.SQL = "Parameters wifenum INT, famnum INT, husbnum INT; UPDATE DISTINCTROW PERSONNAL SET PERSONNAL![MOTHER] = wifenum, PERSONNAL![father] = husbnum  WHERE PERSONNAL![CF] = famnum;"


QUOTES$ = Chr$(34)

Open "GEDCOM.GED" For Input As 1

Line Input #1, LINEIN$

Do While Not EOF(1)
RLOOP1:

If InStr(LINEIN$, "@ INDI") <> 0 Then
MYTABLE.AddNew

INLOOP:

    If InStr(LINEIN$, "@ INDI") <> 0 Then
            FSTAMP = InStr(LINEIN$, "@")
            SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
            WHATTODO$ = Mid$(LINEIN$, SNDAMP + 2, 4)

    Else
            SPC1 = InStr(LINEIN$, " ")
            SPC2 = InStr(SPC1 + 1, LINEIN$, " ")
            If SPC2 = 0 Then
                WHATTODO$ = Mid$(LINEIN$, SPC1 + 1, Len(LINEIN$) - SPC1)
            Else
                WHATTODO$ = Mid$(LINEIN$, SPC1 + 1, SPC2 - SPC1 - 1)
            End If

    End If


    Select Case WHATTODO$


    Case "INDI"

        FSTAMP = InStr(LINEIN$, "@")
        SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
        MYTABLE("PERSONNUM") = Val(Mid$(LINEIN$, FSTAMP + 2))
        
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit

    Case "NAME"

    MYTABLE("GIVEN NAME") = Mid$(LINEIN$, 8, InStr(LINEIN$, "/") - 8)
    MYTABLE("SURNAME") = Mid$(LINEIN$, InStr(LINEIN$, "/") + 1, Len(LINEIN$) - InStr(LINEIN$, "/") - 1)

        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit

Case "SEX"
        MYTABLE("SEX") = Mid$(LINEIN$, 7, 1)

For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit

Next index

Case "BIRT"
BIRTLOOP:
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
      
       SUBWHATTODO$ = Mid$(LINEIN$, 3, 4)
      
Select Case SUBWHATTODO$

Case "DATE"
        TESTDATE = Mid$(LINEIN$, 7)
        If IsDate(TESTDATE) Then
            MYTABLE("DATE OF BIRTH") = CVDate(TESTDATE)
        Else
           MYTABLE("birtH DATE") = TESTDATE
        End If

Case "PLAC"

        MYTABLE("BIRTH PLACE") = Mid$(LINEIN$, 7)

Case Else

For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
          MYTABLE("BIRTH INFO") = MYTABLE("BIRTH INFO") + Mid$(LINEIN$, 7)

Next index

End Select
GoTo BIRTLOOP

Case "OCCU"
MYTABLE("OCCUPATION") = Mid$(LINEIN$, 7)

For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
          MYTABLE("OCCUPATION") = MYTABLE("OCCUPATION") + Mid$(LINEIN$, 7)
Next index

Case "NOTE"
MYTABLE("HISTORY") = Mid$(LINEIN$, 7)


NLOOP:
       
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) < "2" Then
          Close #2
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit

        Else
          MYTABLE("HISTORY") = MYTABLE("HISTORY") + Mid$(LINEIN$, 7)
          GoTo NLOOP
        End If


Case "DEAT"
DEATLOOP:
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
       
       SUBWHATTODO$ = Mid$(LINEIN$, 3, 4)
       
Select Case SUBWHATTODO$

Case "DATE"
        MYTABLE("DEATH DATE") = Mid$(LINEIN$, 7)

Case "PLAC"

        MYTABLE("DEATH PLACE") = Mid$(LINEIN$, 7)

Case Else

For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
         MYTABLE("DEATH INFO") = MYTABLE("DEATH INFO") + Mid$(LINEIN$, 7)
Next index

End Select
GoTo DEATLOOP

Case "BURI"
BURILOOP:
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
      
       SUBWHATTODO$ = Mid$(LINEIN$, 3, 4)
      
Select Case SUBWHATTODO$

Case "DATE"
        MYTABLE("BURIAL DATE") = Mid$(LINEIN$, 7)

Case "PLAC"

        MYTABLE("BURIAL PLACE") = Mid$(LINEIN$, 7)
Case Else

For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
         MYTABLE("BURIAL INFO") = MYTABLE("BURIAL INFO") + Mid$(LINEIN$, 7)
Next index

End Select
GoTo BURILOOP

Case "IMMI"

For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
         MYTABLE("IMMIGRATION") = MYTABLE("IMMIGRATION") + Mid$(LINEIN$, 7)
Next index

Case "FAMC"
FSTAMP = InStr(LINEIN$, "@")
SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
MYTABLE("CF") = Val(Mid$(LINEIN$, FSTAMP + 2))

For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
Next index

Case "FAMS"
For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
Next index


Case Else
Debug.Print LINEIN$, "THIS ITEM NOT FOUND"
For index = 1 To 10
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo INLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo writit
Next index

End Select

GoTo INLOOP
writit:

MYTABLE.Update


GoTo RLOOP1



ElseIf InStr(LINEIN$, "@ FAM") <> 0 Then

FAMLOOP:

If InStr(LINEIN$, "@ FAM") <> 0 Then
       
        FSTAMP = InStr(LINEIN$, "@")
        SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
        WHATTODO$ = Mid$(LINEIN$, SNDAMP + 2, 3)

Else
            SPC1 = InStr(LINEIN$, " ")
            SPC2 = InStr(SPC1 + 1, LINEIN$, " ")
            If SPC2 = 0 Then
                WHATTODO$ = Mid$(LINEIN$, SPC1 + 1, Len(LINEIN$) - SPC1)
            Else
                WHATTODO$ = Mid$(LINEIN$, SPC1 + 1, SPC2 - SPC1 - 1)
            End If

End If

Select Case WHATTODO$

Case "FAM"
FSTAMP = InStr(LINEIN$, "@")
SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
FAMNUM = Val(Mid$(LINEIN$, FSTAMP + 2))

        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo FAMLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo WRITFAMILY


Case "HUSB"
FSTAMP = InStr(LINEIN$, "@")
SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
HUSBNUM = Val(Mid$(LINEIN$, FSTAMP + 2))
       
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo FAMLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo WRITFAMILY

Case "WIFE"
FSTAMP = InStr(LINEIN$, "@")
SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
WIFENUM = Val(Mid$(LINEIN$, FSTAMP + 2))
      
        Line Input #1, LINEIN$
          If Left$(LINEIN$, 1) = "1" Then GoTo FAMLOOP
          If Left$(LINEIN$, 1) = "0" Then GoTo WRITFAMILY

Case "MARR"
FAMTABLE.AddNew
FAMTABLE("PERSONNUM") = HUSBNUM
FAMTABLE("SPOUSE") = WIFENUM
FAMTABLE("FAMILY ID") = FAMNUM
FAMTABLE("type") = "Marriage"
RECTYPE$ = "Marriage"
MARRYLOOP:
        Line Input #1, LINEIN$
         
        If Left$(LINEIN$, 1) = "1" Then
            FAMTABLE.Update
            GoSub COPYREC

            GoTo FAMLOOP
          End If
         
          If Left$(LINEIN$, 1) = "0" Then
            FAMTABLE.Update
            GoSub COPYREC

          GoTo WRITFAMILY
          End If

            SPC1 = InStr(LINEIN$, " ")
            SPC2 = InStr(SPC1 + 1, LINEIN$, " ")
            If SPC2 = 0 Then
                SUBWHATTODO$ = Mid$(LINEIN$, SPC1 + 1, Len(LINEIN$) - SPC1)
            Else
                SUBWHATTODO$ = Mid$(LINEIN$, SPC1 + 1, SPC2 - SPC1 - 1)
            End If


Select Case SUBWHATTODO$

Case "DATE"
        FAMTABLE("date") = Mid$(LINEIN$, SPC2 + 1)
        RECDATE$ = Mid$(LINEIN$, SPC2 + 1)

Case "PLAC"

        FAMTABLE("place") = Mid$(LINEIN$, SPC2 + 1)
        RECPLACE$ = Mid$(LINEIN$, SPC2 + 1)

Case "NOTE"
         FAMTABLE("notes") = Mid$(LINEIN$, SPC2 + 1)
         RECNOTES$ = Mid$(LINEIN$, SPC2 + 1)

Do
       
        Line Input #1, LINEIN$
        If Left$(LINEIN$, 1) = "1" Then
            FAMTABLE.Update
            GoSub COPYREC
            GoTo FAMLOOP
        End If
          
        If Left$(LINEIN$, 1) = "0" Then
            FAMTABLE.Update
            GoSub COPYREC
            GoTo WRITFAMILY
        End If

        
        FAMTABLE("notes") = FAMTABLE("Notes") + Mid$(LINEIN$, SPC2 + 1)
        RECNOTES$ = RECNOTES$ + Mid$(LINEIN$, SPC2 + 1)
        
Loop


Case Else

Do
        Line Input #1, LINEIN$
        If Left$(LINEIN$, 1) = "1" Then
            FAMTABLE.Update
            GoSub COPYREC

          GoTo FAMLOOP
          End If
         

          If Left$(LINEIN$, 1) = "0" Then
            FAMTABLE.Update
            GoSub COPYREC

            GoTo WRITFAMILY
          End If
        
Loop

End Select
GoTo MARRYLOOP

Case "DIV"
FAMTABLE.AddNew
FAMTABLE("FAMILY ID") = FAMNUM
FAMTABLE("type") = "Divorce"
FAMTABLE("PERSONNUM") = HUSBNUM
FAMTABLE("SPOUSE") = WIFENUM

RECTYPE$ = "Divorce"
DIVLOOP:
        Line Input #1, LINEIN$
        If Left$(LINEIN$, 1) = "1" Then
            FAMTABLE.Update
            GoSub COPYREC

            GoTo FAMLOOP
          End If
         
          If Left$(LINEIN$, 1) = "0" Then
            FAMTABLE.Update
            GoSub COPYREC

            GoTo WRITFAMILY
          End If
    
            SPC1 = InStr(LINEIN$, " ")
            SPC2 = InStr(SPC1 + 1, LINEIN$, " ")
            If SPC2 = 0 Then
                SUBWHATTODO$ = Mid$(LINEIN$, SPC1 + 1, Len(LINEIN$) - SPC1)
            Else
                SUBWHATTODO$ = Mid$(LINEIN$, SPC1 + 1, SPC2 - SPC1 - 1)
            End If

Select Case SUBWHATTODO$

Case "DATE"
        FAMTABLE("date") = Mid$(LINEIN$, SPC2 + 1)
        RECDATE$ = Mid$(LINEIN$, SPC2 + 1)

Case "PLAC"

        FAMTABLE("place") = Mid$(LINEIN$, SPC2 + 1)
        RECPLACE$ = Mid$(LINEIN$, SPC2 + 1)

Case "NOTE"
         FAMTABLE("notes") = Mid$(LINEIN$, SPC2 + 1)
         RECNOTES$ = Mid$(LINEIN$, SPC2 + 1)

Do
       
        Line Input #1, LINEIN$
        If Left$(LINEIN$, 1) = "1" Then
            FAMTABLE.Update
            GoSub COPYREC
            GoTo FAMLOOP
        End If
          
        If Left$(LINEIN$, 1) = "0" Then
            FAMTABLE.Update
            GoSub COPYREC
            GoTo WRITFAMILY
        End If

        
        FAMTABLE("notes") = FAMTABLE("Notes") + Mid$(LINEIN$, SPC2 + 1)
        RECNOTES$ = RECNOTES$ + Mid$(LINEIN$, SPC2 + 1)
        
Loop


Case Else


Do
        Line Input #1, LINEIN$
        If Left$(LINEIN$, 1) = "1" Then
            FAMTABLE.Update
            GoSub COPYREC

            GoTo FAMLOOP
          End If
         
          If Left$(LINEIN$, 1) = "0" Then
            FAMTABLE.Update
            GoSub COPYREC

            GoTo WRITFAMILY
          End If
         
        

Loop

End Select
GoTo DIVLOOP


Case "CHIL"
FSTAMP = InStr(LINEIN$, "@")
SNDAMP = InStr(FSTAMP + 1, LINEIN$, "@")
CHILDNUM = Val(Mid$(LINEIN$, FSTAMP + 2))

CHILDTABLE.AddNew
CHILDTABLE("Parent") = HUSBNUM
CHILDTABLE("PERSONNUM") = CHILDNUM
CHILDTABLE("CF") = FAMNUM
CHILDTABLE("SPOUSE") = WIFENUM
CHILDTABLE.Update

CHILDTABLE.AddNew
CHILDTABLE("Parent") = WIFENUM
CHILDTABLE("PERSONNUM") = CHILDNUM
CHILDTABLE("CF") = FAMNUM
CHILDTABLE("SPOUSE") = HUSBNUM
CHILDTABLE.Update

        Line Input #1, LINEIN$
        If Left$(LINEIN$, 1) = "1" Then GoTo FAMLOOP
        If Left$(LINEIN$, 1) = "0" Then GoTo WRITFAMILY

        
Case Else
Debug.Print LINEIN$, "THIS ITEM NOT FOUND"
    Do
        Line Input #1, LINEIN$
        If Left$(LINEIN$, 1) = "1" Then GoTo FAMLOOP
        If Left$(LINEIN$, 1) = "0" Then GoTo WRITFAMILY
    Loop

End Select

WRITFAMILY:





Set myquery = mydb.OpenQueryDef("add parents")
myquery.WIFENUM = WIFENUM
myquery.HUSBNUM = HUSBNUM
myquery.FAMNUM = FAMNUM

myquery.Execute

myquery.Close



End If

Loop

GoTo GETOUT

COPYREC:

FAMTABLE.AddNew
FAMTABLE("PERSONNUM") = WIFENUM
FAMTABLE("FAMILY ID") = FAMNUM
FAMTABLE("type") = RECTYPE$
FAMTABLE("DATE") = RECDATE$
FAMTABLE("PLACE") = RECPLACE$
FAMTABLE("NOTES") = RECNOTES$
FAMTABLE("SPOUSE") = HUSBNUM
FAMTABLE.Update

RECTYPE$ = ""
RECDATE$ = ""
RECPLACE$ = ""
RECNOTES$ = ""

Return


GETOUT:

mydb.DeleteQueryDef ("add parents")

Close #1
MYTABLE.Close

FAMTABLE.Close

End Function

      
