用户定义types读取错误
我正在为一个（我的）小企业开发一个系统。 我有大约20个数据文件（客户/供应商/商店项目/固定资产/租赁/雇员等）。这些文件的每个logging都是使用Type语句定义的，并使用Put或Get语句进行书写或读取。
每个数据文件都用一个单独的工作簿进行维护或增加。 我也有单独的工作簿来控制公司的日常stream程。 （销售/租赁/商店移动等）这些“操作”工作簿严重依赖于数据文件中的logging。 他们还生产进一步的日常移动数据文件。
该系统由一个名为Menu.xlsm的工作簿控制，该工作簿允许用户select所需的工作簿。 Menu.xlsm包含所有的types语句，通用程序，函数和表单。 它在所有其他工作簿中引用，并始终打开。 用户被限制在两个打开的工作簿 – 菜单和另一个。
系统位于networking服务器上，写入的方式是用户只能打开工作簿“只读”。 用户从不保存工作簿，他们总是将数据保存到数据文件。
基本上我有一个数据库系统，并使用Excel作为接口。
我的types语句是
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. 我完全肯定地知道Len（CLoc）= 223
这个特定的文件控制公司的租赁合同。 我们租给我们的客户。 我是英国人，但是让巴西成为我的家。 因此一些元素名称是葡萄牙语。
每当用户打开Rental Workbook时，该文件（Rental.rnd）将由workbook_open（）调用的标准模块过程（LoadData（））自动加载。
这是LoadData过程。 一些不相关的代码被省略（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
当错误没有发生时，数据可以正确加载。
发生错误时，取消注释On错误命令并重新运行程序。 程序正常结束，表中的数据表明数据已被正确读取到Cloc。 QtOut和后续的元素没有阅读。
看起来'错误59错误logging长度'是'VBAparsing代码'无法解释由Get语句读取的CLoc缓冲区数据的字节210到213中的数据的结果。
为了validation这个，我添加了这个代码：
Type AllClocDesc StAll As String * 223 End Type Dim AllCloc As AllClocDesc ...and ... Get #1, I, AllCloc
因此，我有一个223字节的string（AllCloc.StAll）与由有问题的Get＃1，I，Cloc读取的缓冲区相同。 然后我编写了一个程序来parsing这个string并validation磁盘上的数据。 如果你愿意，我可以发布代码）。 磁盘上的数据是正确的。 如果我closures并重新打开工作簿，错误仍然存在。
正如我上面所说，CLoc的types声明和公共decalarion在Menu.xlsm中。 LoadData代码和错误生成代码位于名为Rentals.xlsm的工作簿中。 所以，我closures了Rentals.xlsm。 在Menu.xlsm中，我将“公共CLoc作为CLocDesc”剪切并粘贴在一个稍微不同的地方。 然后debugging/编译和保存，但不closures，Menu.xlsm。 就好像通过魔法LoadData（）正常完成，具有正确的数据。
Menu.xlsm的保存副本应该与刚刚正确运行的副本相同。 closuresRental.xlsm，closuresMenu.xlsm。 重新打开Menu.xlsm，重新打开Rental.xlsm。 失败！ 错误59logging长度不正确。
我在上面说过，用户打开工作簿“只读”，因此两个用户可以几乎同时打开工作簿。 一个用户通常收到错误59，而另一个用户收到错误。 相同的工作簿和相同的数据！
我大概有30个随机存取文件。 其中大约有10个在过去或现在给出相同的问题。 我有22个工作簿共4.04 MB。 我已经停止添加更简单，因为用户不再能够使用该系统。
我曾想过使用类模块的数据。 但是30个类模块而不是30个types的语句。 谈论一个大锤打破坚果。 当我第一次开始使用打印/写入和分隔符。 当用户开始在他们的文本中包括逗号，分号和引号时，我很快放弃了。 我相信微软故意为了我使用它的目的而创build了UDT / Get / Put。
这里发生了一些非常非常奇怪的事情。
我该如何解决我的问题？
伊恩·西蒙斯
使用Open For Random是不理想的，因为它将string从2个字节的BSTR / UTF16转换为1个字节的ANSI，具有取决于字符的潜在损失。 这就是说，你的问题可能是由于竞争条件，或者程序试图加载损坏的或不同的logging。
相反，使用“ Open For Binary Shared来读/写数据而无需转换，只需一次调用即可：
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
但是使用直接存储在文件中的logging将会是一个很难维护的工作，因为如果某些时候需要添加新的字段/列，则必须手动更新大部分logging。
更好的解决scheme是build立一个数据库。 您可以使用Access数据库，或使用ADO连接访问的简单Excel文件。
一个简单的select是使用一个Recordset来保存/加载logging到/从一个文件：
' 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
@伊姆·西蒙兹，在你的问题文本中，你说你已经试过了
Type AllClocDesc StAll As String * 223 End Type Sub Test() '... Dim AllCloc As AllClocDesc '...and ... Get #1, I, AllCloc End Sub
也许尝试用一个字节数组来诊断正在发生的事情
Type AllClocDesc2 abAllBytes(0 To 222) As Byte End Type Sub Test2() Dim I, l 'Dim AllCloc As AllClocDesc Dim AllCloc2 As AllClocDesc2 '...and ... Get #1, I, AllCloc2 LSet CLoc = AllCloc2 End Sub
LSet复制字节的字节。 您可以检查复制到多字段types的内容，并通过查看字节数组来检查磁盘上的内容。 希望这可以帮助。