Here is the code. It requires two tables. I'll post the table details in another post. You should be able to copy and paste this into Access. You may be able to discern the table names and field names based on what is being populated in the code.
What I found when I examined the .crd file structure, briefly, was the the each card title was 40 bytes in length. All the card file titles are stored one after another. All the card contents are stored together, one after the other. The problem I had was trying
to figure out how the program knew which card title belonged to which content. What I found was, stored with the card's title, there is a 3 byte address that points to the position of each card's contents in the .crd file.
I no longer have a .crd file to run this code on. I'd have to look at ancient backups to find one.
Let me know if you have issues.
You will also need to change the file path and name in the code. I never implemented having the code open a file dialog box to grab file location.
Dave
Function ReadCard()
On Error GoTo Err_ReadCard
Dim dbCard As Database
Dim rstCard As Recordset
Dim C1 As Long ' represents each character as it's read in - also used as 1st byte of 3-byte address
Dim C2 As Long ' read second character in 3-byte address
Dim C3 As Long ' read third character in 3-byte address
Dim P1 As Long ' position, in bytes into the file, starting with 0 as start of file
Dim P2 As Long ' position, in bytes relative to P1
Dim a As Integer 'reusable loop counter
Dim b As Integer 'reusable loop counter
Dim HeadLen As Long ' length in bytes of header/tab area. bytes to first card content
Dim FieldID As Long ' primary key
Dim strField As String 'concatenated string for card title
Dim FSize As Long 'file size
Dim CSize As Long 'length of card contents for a particular record
Set dbCard = DBEngine.Workspaces(0).Databases(0)
Set rstCard = dbCard.OpenRecordset("tblCardInput", dbOpenDynaset)
P1 = 0 'initialize byte counter
Open "c:\windows\address.crd" For Binary As #1
FSize = LOF(1)
'Step 1
For a = 1 To 12 ' step over first 11 characters and grab the 12th character
C1 = Asc(Input(1, #1))
P1 = P1 + 1 'increment byte counter
Next a
'Step 2
C2 = Asc(Input(1, #1)) 'read second byte of three byte address
P1 = P1 + 1 'increment byte counter
C3 = Asc(Input(1, #1)) 'read third byte of three byte address
P1 = P1 + 1 'increment byte counter
HeadLen = GetContactID(C1, C2, C3) 'get number of bytes for header area
FieldID = HeadLen ' get number of bytes ContactID to content for this entry
'Step 3
For a = 1 To 3 'setp over next 2 bytes and grab the 3rd as the start of the card title
C1 = Asc(Input(1, #1))
P1 = P1 + 1 'increment byte counter
Next a
GoSub GetTitle
Do Until P1 >= HeadLen - 1 'step through the header area
'Step 4,5
GoSub GetAddress
For a = 1 To 3 'setp over next 2 bytes and grab the 3rd as the start of the card title
C1 = Asc(Input(1, #1))
P1 = P1 + 1 'increment byte counter
Next a
GoSub GetTitle
Loop
FieldID = HeadLen
rstCard.Close 'close table
'Populate table with card contents
Set rstCard = dbCard.OpenRecordset("tblCardInputDetails", dbOpenDynaset)
'At this point P1 should be equal to the starting address of the card contents
Do Until P1 = FSize - 1
C1 = Asc(Input(1, #1))
P1 = P1 + 1 'increment byte counter
C1 = Asc(Input(1, #1))
P1 = P1 + 1 'increment byte counter
C2 = Asc(Input(1, #1))
P1 = P1 + 1 'increment byte counter
CSize = GetContactID(C1, C2, 0)
C1 = Asc(Input(1, #1))
P1 = P1 + 1 'increment byte counter
GoSub GetContents
Loop
rstCard.Close 'close table
Close #1 ' Close file.
Exit_ReadCard:
Close #1
Exit Function
Err_ReadCard:
Close #1
MsgBox Err.Description
Resume Exit_ReadCard
GetContents:
P2 = 1
While P2 <= CSize
Do Until C1 = 13 Or C1 = 0 'first carrige return signifies end of line
strField = strField + Chr(C1) 'keep concatenating
If P1 = FSize - 1 Then Exit Do
C1 = Asc(Input(1, #1)) 'Read one character.
P1 = P1 + 1 'increment byte counter
P2 = P2 + 1
Loop
If Len(strField) > 40 Then
For b = 1 To Len(strField) Step 40
rstCard.AddNew
rstCard!ContactID = FieldID
rstCard!Contents = Mid(strField, b, 40)
rstCard.Update
Next b
strField = "" 'reset card title
Else
rstCard.AddNew
rstCard!ContactID = FieldID
rstCard!Contents = strField
rstCard.Update
strField = "" 'reset card title
End If
If C1 = 13 Then 'if CR then step over LF
C1 = Asc(Input(1, #1)) ' Read one character.
C1 = Asc(Input(1, #1)) ' Read one character.
P1 = P1 + 2 'increment byte counter
P2 = P2 + 2
End If
If P1 = FSize - 1 Then Return
Wend
FieldID = P1
Return
GetAddress:
'C1 is already set to first byte of three byte address
C2 = Asc(Input(1, #1)) 'read second byte of three byte address
P1 = P1 + 1 'increment byte counter
C3 = Asc(Input(1, #1)) 'read third byte of three byte address
P1 = P1 + 1 'increment byte counter
FieldID = GetContactID(C1, C2, C3) ' get number of bytes ContactID to contents of this entry
Return
GetTitle:
P2 = 0
Do
If C1 <> 0 Then 'first zero byte signifies end of title
strField = strField + Chr(C1) 'keep concatenating
Else
rstCard.AddNew
rstCard!ContactID = FieldID
rstCard!ContactName = strField
rstCard.Update
strField = "" 'reset card title
Exit Do
End If
C1 = Asc(Input(1, #1)) ' Read one character.
P1 = P1 + 1 'increment byte counter
P2 = P2 + 1
Loop
For a = P2 To 46 'Step over remainder of 40 character title entry then 7 zero bytes to next address
C1 = Asc(Input(1, #1)) ' Read one character.
If P1 = HeadLen Then
Exit For
Else
P1 = P1 + 1 'increment byte counter
End If
Next a
Return
End Function
Function GetContactID(intByte1 As Long, intByte2 As Long, intByte3 As Long)
GetContactID = intByte1 + (intByte2 * 256) + (intByte3 * 65536)
End Function
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
