User Define Type Read Error

Question

I am developing a system for a (my) small business. I have about 20 data files (Clients / suppliers / stores items / fixed assets / rentals / employees ...etc.) Each record of these files is defined using a Type statement and written or read using a Put or Get statement.
Each data file is maintained or incremented with a separate Workbook. I also have separate workbooks to control the day to day processes of the company. (Sales / Rentals / store movement etc.) These 'operational' workbooks rely heavily on the records from the data files. They also produce further data files for daily movements.
The system is controlled by one Workbook called Menu.xlsm which allows the user to select the desired workbook. Menu.xlsm contains all the type statements, general procedures, functions and Forms. It is referenced in all other workbooks and is always open. The user is restricted to two open workbooks - Menu and one other.
The system is on a network server and written in such a way that the user can only open the workbooks 'read-only'. The user NEVER saves a workbook, they always save the data to a data file.
Basically I have a database system and am using Excel as the interface.

My Type statement is

Public Type CLocDesc
   Atv As String * 3
   CadName As String * 10
   CadDate As Date
   EditName As String * 10
   EditDate As Date
   Empresa As String * 10
   OSNo As Integer
   ClNo As Integer
   Fantasia As String * 30
   Cidade As String * 40
   UF As String * 2
   PedClient As String * 30
   InsCid As String * 30
   InsUF As String * 2
   DtStart As Date
   DtEnd As Date
   QtMod As Integer
   QtAr As Integer
   QtOut As Integer
   LocMods As Single
   LocAr As Single
   LocOther As Single
   LocVenc As Integer
End Type
Public CLoc As CLocDesc  ' This appears at the top of the module.

I know with absolute certainty that Len(CLoc) = 223
This particular file controls the company's rental contracts. We rent to our clients. I am English but have made Brazil my home. Thus some of the element names are Portuguese.
Whenever a user opens the Rental Workbook this file (Rental.rnd) is loaded automatically by a standard module procedure(LoadData()) called by workbook_open().
This is the LoadData proceedure. Some non relevant code is omitted.(Condicional load / % load indication / table sizing)

'                                                      LOAD  DATA  .
Sub LoadData()
Open Range("MDP") + "Rental.rnd" For Random As #1 Len = Len(Cloc)
Nitems = LOF(1) / Len(Cloc)       ' Number of records
J = 0                             ' Line counter for data table
With Range("DataTable")
   For I = 1 To Nitems
   '                      On Error Resume Next
   Get #1, I, Cloc               ' This command  : Error 59 - Bad record length.
   '                      On Error GoTo 0
   J = J + 1
   .Cells(J, 1) = I
   .Cells(J, 2) = Trim(Cloc.CadName)
   .Cells(J, 3) = Cloc.CadDate
   .Cells(J, 4) = Trim(Cloc.EditName)
   .Cells(J, 5) = Cloc.EditDate
   .Cells(J, 6) = Trim(Cloc.Atv)
   .Cells(J, 7) = Trim(Cloc.Empresa)
   .Cells(J, 8) = Cloc.OSNo
   .Cells(J, 9) = Cloc.ClNo
   .Cells(J, 10) = Trim(Cloc.Fantasia)
   .Cells(J, 11) = Trim(Cloc.Cidade)
   .Cells(J, 12) = Trim(Cloc.uf)
   .Cells(J, 13) = Trim(Cloc.PedClient)
   .Cells(J, 14) = Trim(Cloc.InsCid)
   .Cells(J, 15) = Trim(Cloc.InsUF)
   .Cells(J, 16) = Cloc.DtStart
   .Cells(J, 17) = Cloc.DtEnd
   .Cells(J, 18) = Cloc.QtMod
   .Cells(J, 19) = Cloc.QtAr
   .Cells(J, 20) = Cloc.QtOut
   .Cells(J, 21) = Cloc.LocMods         ' Bad read starts here
   .Cells(J, 22) = Cloc.LocAr
   .Cells(J, 23) = Cloc.LocOther
   .Cells(J, 24) = Cloc.LocOther + Cloc.LocAr + Cloc.LocMods
   .Cells(J, 25) = Cloc.LocVenc
   Next I
End With
Close
End Sub

When the error does not occur the data loads correctly.
When the error does occur I uncomment the On error commands and rerun the program. The program finishes normally and the data in the table indicates that the data has been correctly read up to Cloc. QtOut and subsequent elements not read.
It would appear that the 'Error 59 Bad record length' is a result of the 'VBA parsing code' being unable to interpret the data in bytes 210 to 213 of the CLoc buffer data read by the Get statement.
To verify this I added this code :

Type AllClocDesc
   StAll As String * 223
End Type
Dim AllCloc As AllClocDesc
...and ...
Get #1, I, AllCloc

Thus I have a 223 byte string (AllCloc.StAll) identical to the buffer read by the offending Get #1, I, Cloc. I then wrote a proccedure to parse this string and verify the data on disk. I can post the code if you wish). The data on disk is CORRECT. If I close and reopen the workbook the error persists.

As I said above the type statement and public decalarion of CLoc is in Menu.xlsm. The LoadData code and hence the error producing code is in a workbook called Rentals.xlsm. So, I close Rentals.xlsm. In Menu.xlsm i cut 'Public CLoc As CLocDesc' and paste it in a slightly different place. Then debug/compile and Save, but do not close, Menu.xlsm. As if by magic LoadData() completes normally, with the correct data.

The saved copy of Menu.xlsm should be identical to that which just ran correctly. Close Rental.xlsm, Close Menu.xlsm. Reopen Menu.xlsm, Reopen Rental.xlsm. FAIL !! Error 59 Bad record length.

I stated above that the users open the workbooks "read only", thus two users can open the workbook (almost) simultaneously. It is common for one user to receive error 59 and the other not. The same workbook and the same data!

I have around 30 random access files in all. About 10 of them have in the past or are currently giving identical problems. I have 22 workbooks totaling 4.04 MB. I have stopped adding more simply because the users are no longer able to use the system.

I have thought about using class modules for the data. But 30 class modules instead of 30 type statements. Talk about a sledgehammer to crack a nut. When I first started I used print/write and delimiters. I gave up very quickly when the users started including comas, semicolons and quotation marks in their texts. I believe that Microsoft deliberately created the UDT/Get/Put for the purpose for which I am using it.

There is something very very very strange happening here.

How can I solve my problem ?

Ian Simmons

This is an update to the posts above. As my company has a subscription for Office 365 I decided to invoke the help of M microsoft. The first problem was to find the registered user – who had permission to open a support ticket. It turned out to be the retailer who sold us the subscription.(Not my IT guy??). The promised 4 hour return ended up taking 3 days. Finally we had a conference call – myself / a microsoft engineer / analyst and somebody from the retailer. Both tried to explain to me that since the problem was with my code they (microsoft) were unable to help. Ticket : SUP86188 - LATAM-BR-MSFT-O365-Solicitação Eng microsoft To open the ticket, I had to submit details of the problem to the retailer and I included a list of the posts that I had made. The conference call failed several times, finally the microsoft engineer/analyst called me directly and admitted that after consulting the posts, he too was convinced that this was a BUG and suggested that I report it to microsoft. I asked why HE could not report it and he replied that he was NOT ALLOWED to. I wish I had recorded that conversation! Later I received an email from the retailer stating that the ticket was RESOLVED and closed. This is disgusting behaviour from a multinational. I have deliberately omitted names from this post - the ticket number is sufficient should anyone from microsoft be interested. Any suggestions?

Answer 1

Using Open For Random is not ideal given that it will convert the strings from BSTR/UTF16 on 2 bytes to ANSI on 1 byte with a potential loss depending on the character. That said, your issue could be due to a race condition or maybe the procedure is trying to load a corrupted or a different record.

Instead, use Open For Binary Shared to read/write the data without conversion and in a single call:

Private Declare PtrSafe Sub MemCpy Lib "kernel32" Alias "RtlMoveMemory" (dst As Any, src As Any, ByVal size As LongPtr)

Const path = "c:\temp\record.bin"

Sub AddRecord()

  ' dummy record '
  Dim record As CLocDesc
  record.Atv = "123"
  record.LocMods = 1.76

  ' to binary '
  Dim buffer() As Byte
  ReDim buffer(0 To LenB(record) - 1)
  MemCpy buffer(0), ByVal VarPtr(record), LenB(record)

  ' check file length is a multiple of the record length '
  If Len(Dir(path)) Then If FileLen(path) Mod LenB(record) Then _
    Err.Raise 5, , "Unexpected file length"

  ' to file '
  Dim f As Integer
  f = FreeFile
  Open path For Binary Shared As f
    Put f, FileLen(path) + 1, buffer
  Close

End Sub

Sub LoadRecords()

  ' check file length is a multiple of the record length '
  Dim record As CLocDesc
  If FileLen(path) Mod LenB(record) Then Err.Raise 5, , "Unexpected file length"

  ' load file to buffer '
  Dim f As Integer, p As Long, buffer() As Byte
  ReDim buffer(0 To FileLen(path) - 1)

  f = FreeFile
  Open path For Binary Shared As f
    Get f, 1, buffer
  Close

  ' to records '
  Dim records() As CLocDesc
  ReDim records(0 To FileLen(path) \ LenB(record) - 1)
  MemCpy ByVal VarPtr(records(0)), buffer(0), UBound(buffer) + 1

End Sub

But working with records stored directly in a file is going to be a pain to maintain since you'll have to manually update most of them if at some point you need to add a new field/column.

A better solution would be to setup a database. You could use an Access database, or a simple Excel file accessible with an ADO connection.

A simple alternative would be to use a Recordset to save/load the records to/from a file:

' Required reference: Microsoft ActiveX Data Objects '

Sub UsageRecordset()
  Dim rs As ADODB.Recordset, fields As ADODB.fields, i As Long

  ' create a recordset, define the fields and save it to a file '

  Set rs = New ADODB.Recordset
  rs.CursorLocation = adUseClient

  Set fields = rs.fields
  fields.Append "Id", adBSTR, 8
  fields.Append "Price", adDouble

  rs.Open
  rs.Save "c:\temp\records.dat"
  rs.Close

  ' add some records '

  Set rs = New ADODB.Recordset
  rs.CursorLocation = adUseClient
  rs.Open "c:\temp\records.dat"

  rs.AddNew
  rs("Id").value = "kt547865"
  rs("Price").value = 4.7

  rs.AddNew
  rs("Id").value = "kt986543"
  rs("Price").value = 2.3

  rs.Save
  rs.Close

  ' read all the records to a sheet '

  Set rs = New ADODB.Recordset
  rs.CursorLocation = adUseClient
  rs.Open "c:\temp\records.dat"

  rs.MoveFirst
  ActiveSheet.Range("A2").CopyFromRecordset rs

  rs.Close

  ' iterate all the records '

  Set rs = New ADODB.Recordset
  rs.CursorLocation = adUseClient
  rs.Open "c:\temp\records.dat"

  rs.MoveFirst
  For i = 1 To rs.RecordCount
    Debug.Print rs("Id").value
    Debug.Print rs("Price").value
    rs.MoveNext
  Next

  rs.Close

  ' find a specific record '

  Set rs = New ADODB.Recordset
  rs.CursorLocation = adUseClient
  rs.Open "c:\temp\records.dat", LockType:=adLockReadOnly

  rs.MoveFirst
  rs.Find "[Price] < 5", , 1, 2

  If Not rs.EOF Then
    Debug.Print rs("Id").value
    Debug.Print rs("Price").value
  End If

  rs.Close

End Sub