用户定义类型读取错误

Question

我正在为一家小企业开发一个系统。我有大约20个数据文件(客户/供应商/商店项目/固定资产/租赁/员工...etc。)这些文件的每个记录都是使用Type语句定义的，并使用Put或Get语句写入或读取。

每个数据文件都使用单独的工作簿进行维护或递增。我也有单独的工作簿来控制公司的日常流程。(销售/租赁/门店移动等)这些“可操作的”工作簿严重依赖于数据文件中的记录。它们还为日常运动生成更多的数据文件。

系统由一个名为Menu.xlsm的工作簿控制，该工作簿允许用户选择所需的工作簿。Menu.xlsm包含所有类型语句、通用过程、函数和表单。它在所有其他工作簿中都被引用，并且始终处于打开状态。用户被限制为两个打开的工作簿-菜单和另一个。

该系统位于网络服务器上，并且以这样的方式编写:用户只能以只读方式打开工作簿。用户从不保存工作簿，他们总是将数据保存到数据文件中。

基本上，我有一个数据库系统，并使用Excel作为接口。

我的Type语句是

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.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

当错误没有发生时，数据加载正确。

当错误确实发生时，我取消对错误命令的注释，然后重新运行程序。程序正常结束，表中的数据表明数据已正确读取到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的类型声明和公共十进制数是在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.04MB。我已经停止添加更多，因为用户不再能够使用系统。

我已经考虑过对数据使用类模块。而是30个类模块，而不是30个类型语句。说到用大锤子敲坚果。当我刚开始的时候，我使用了打印/写入和分隔符。当用户开始在他们的文本中添加逗号、分号和引号时，我很快就放弃了。我相信微软故意创建UDT/Get/Put是为了达到我使用它的目的。

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

我如何解决我的问题？

伊恩·西蒙斯

这是上述帖子的更新。由于我的公司订阅了Office 365，因此我决定求助于M microsoft。第一个问题是找到注册用户--该用户有权打开支持票证。原来是零售商把订阅卖给我们的。(不是我的It人员？？)。承诺的4小时回报最终花了3天。最后，我们召开了一次电话会议--我自己/一位微软工程师/分析师和零售商的某个人。两人都试图向我解释说，由于问题出在我的代码上，他们(微软)无法提供帮助。工单: SUP86188 - LATAM-BR-MSFT-O365-Solicitação Eng microsoft要打开工单，我必须向零售商提交问题的详细信息，并包括我所做的帖子的列表。电话会议失败了几次，最后微软工程师/分析师直接打电话给我，承认在查阅了帖子后，他也确信这是一个错误，并建议我向微软报告。我问他为什么不能报告这件事，他回答说他不被允许报告。我真希望我录下了那段对话！后来，我收到一封来自零售商的电子邮件，说罚单已经解决并关闭。这是一家跨国公司的令人厌恶的行为。我故意在这篇文章中省略了名字--如果微软的任何人对此感兴趣，票号就足够了。有什么建议吗？

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

Answer 2

@Ian Simmonds，在你的问题文本中你说你已经尝试过了

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逐字节复制。您可以检查复制到多字段类型中的内容，还可以通过查看字节数组来检查磁盘上实际存在的内容。希望这能有所帮助。