vba - 用户定义类型读取错误

Question

我正在为(我的)小企业开发一个系统。我有大约 20 个数据文件(客户/供应商/商店项目/固定 Assets /租金/员工......等)这些文件的每条记录都使用 Type 语句定义，并使用 Put 或 Get 语句写入或读取。
每个数据文件都使用单独的工作簿进行维护或递增。
我还有单独的工作簿来控制公司的日常流程。 (销售/租赁/商店移动等)这些“运营”工作簿严重依赖数据文件中的记录。他们还为日常运动生成更多数据文件。
该系统由一个名为 Menu.xlsm 的工作簿控制，它允许用户选择所需的工作簿。 Menu.xlsm 包含所有类型语句、通用程序、函数和表单。它在所有其他工作簿中被引用并且始终处于打开状态。用户仅限于两个打开的工作簿 - 菜单和另一个。
该系统位于网络服务器上，并且以用户只能以“只读”方式打开工作簿的方式编写。用户从不保存工作簿，他们总是将数据保存到数据文件中。
基本上我有一个数据库系统，并使用 Excel 作为界面。

我的类型声明是

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
该特定文件控制公司的租赁契约(Contract)。我们出租给我们的客户。我是英国人，但巴西是我的家。因此一些元素名称是葡萄牙语。
每当用户打开租赁工作簿时，此文件 (Rental.rnd) 都会由 workbook_open() 调用的标准模块过程 (LoadData()) 自动加载。
这是 LoadData 过程。省略了一些不相关的代码。(条件负载/% 负载指示/表格大小)

'                                                      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 error 命令并重新运行程序。程序正常完成，表中的数据表明数据已正确读取到 Cloc。未读取 QtOut 和后续元素。
看起来“错误 59 错误记录长度”是“VBA 解析代码”无法解释 Get 语句读取的 CLoc 缓冲区数据的字节 210 到 213 中的数据的结果。
为了验证这一点，我添加了以下代码:

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

因此，我有一个 223 字节的字符串 (AllCloc.StAll)，与违规 Get #1, I, Cloc 读取的缓冲区相同。然后我写了一个程序来解析这个字符串并验证磁盘上的数据。如果您愿意，我可以发布代码)。磁盘上的数据是正确的。
如果我关闭并重新打开工作簿，错误仍然存​​在。

正如我上面所说，CLoc 的类型声明和公共(public)声明在 Menu.xlsm 中。 LoadData 代码以及由此产生的错误代码位于名为 Rentals.xlsm 的工作簿中。
所以，我关闭了Rentals.xlsm。在 Menu.xlsm 中，我剪切了“Public CLoc As CLocDesc”并将其粘贴到稍微不同的地方。然后调试/编译并保存，但不要关闭 Menu.xlsm。
好像通过魔术 LoadData() 正常完成，并带有正确的数据。

Menu.xlsm 的保存副本应该与刚刚正确运行的副本相同。
关闭 Rental.xlsm，关闭 Menu.xlsm。重新打开 Menu.xlsm，重新打开 Rental.xlsm。
失败 !!错误 59 错误的记录长度。

我在上面说过，用户以“只读”方式打开工作簿，因此两个用户可以(几乎)同时打开工作簿。一个用户收到错误 59 而另一个则没有，这是很常见的。相同的工作簿和相同的数据!

我总共有大约 30 个随机访问文件。其中大约有 10 个在过去或现在出现了相同的问题。我有 22 个工作簿，总共 4.04 MB。我已停止添加更多内容，因为用户不再能够使用该系统。

我已经考虑过使用类模块来处理数据。但是 30 个类模块而不是 30 个类型语句。谈论敲碎坚果的大锤。
当我第一次开始时，我使用了打印/写入和分隔符。当用户开始在他们的文本中包含逗号、分号和引号时，我很快就放弃了。
我相信 Microsoft 故意创建 UDT/Get/Put 是为了我使用它的目的。

这里发生了一些非常非常非常奇怪的事情。

我该如何解决我的问题？

伊恩·西蒙斯

这是对上述帖子的更新。
由于我的公司订阅了 Office 365，我决定调用 M microsoft 的帮助。
第一个问题是找到注册用户——谁有权打开支持票。结果是向我们出售订阅的零售商。(不是我的 IT 人员？？)。 promise 的 4 小时返回最终花了 3 天。最后，我们召开了电话 session ——我本人/微软工程师/分析师和零售商的某个人。两人都试图向我解释，由于问题出在我的代码上，他们(微软)无法提供帮助。
票 : SUP86188 - LATAM-BR-MSFT-O365-Solicitação Eng microsoft
要打开票证，我必须向零售商提交问题的详细信息，并附上我发布的帖子列表。几次电话 session 都失败了，最后微软工程师/分析师直接调用我，承认在查阅帖子后，他也确信这是一个BUG，并建议我向微软报告。我问他为什么不能报告，他回答说他不被允许。
我真希望我能记录下那次谈话!
后来我收到了零售商发来的电子邮件，说明该票已解决并已关闭。
这是跨国公司令人作呕的行为。
我在这篇文章中故意省略了名字——如果微软的任何人感兴趣，票号就足够了。
有什么建议？

Answer 1

使用 Open For Random不理想，因为它将字符串从 2 个字节的 BSTR/UTF16 转换为 1 个字节的 ANSI，并且可能会丢失取决于字符。也就是说，您的问题可能是由于竞争条件，或者程序正在尝试加载损坏或不同的记录。

相反，使用 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

但是使用直接存储在文件中的记录将很难维护，因为如果在某些时候您需要添加新的字段/列，您将不得不手动更新其中的大部分。

更好的解决方案是设置数据库。您可以使用 Access 数据库，或使用 ADO connection 访问的简单 Excel 文件。 .

一个简单的替代方法是使用 Recordset将记录保存到文件/从文件加载记录:

' 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