用户定义类型读取错误

问题描述 投票：11回答：2

我正在为（我的）小企业开发一个系统。我有大约20个数据文件（客户/供应商/商店项目/固定资产/租赁/员工......等）。这些文件的每个记录都是使用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 此特定文件控制公司的租赁合同。我们租给我们的客户。我是英国人但是把巴西变成了我的家。因此，一些元素名称是葡萄牙语。 每当用户打开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错误记录长度”似乎是“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读取的缓冲区相同。然后我写了一个proccedure来解析这个字符串并验证磁盘上的数据。如果你愿意，我可以发布代码）。磁盘上的数据是正确的。如果我关闭并重新打开工作簿，则错误仍然存​​在。

正如我上面所说的CLoc的类型声明和公共decalarion在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个类型的语句。谈论一把大锤来破解坚果。当我第一次开始时，我使用了打印/写入和分隔符。当用户开始在他们的文本中包含逗号，分号和引号时，我很快就放弃了。我相信微软故意为我正在使用它的目的创建了UDT / Get / Put。

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

我怎样才能解决我的问题？

伊恩西蒙斯

这是对上述帖子的更新。由于我的公司订阅了Office 365，我决定调用M microsoft的帮助。第一个问题是找到注册用户 - 谁有权打开支持票。原来是零售商向我们出售了订阅。（不是我的IT人员？）。承诺的4小时回程最终耗时3天。最后我们召开了一次电话会议 - 我自己/一位微软工程师/分析师和零售商的某个人。两人都试图向我解释，由于问题出在我的代码中，他们（微软）无法提供帮助。门票：SUP86188 - LATAM-BR-MSFT-O365-SolicitaçãoEngmicrosoft要打开门票，我必须向零售商提交问题的详细信息，并且我列出了我所做的帖子。电话会议多次失败，最后微软工程师/分析师直接打电话给我，并承认在查阅帖子后，他也确信这是一个BUG，并建议我向微软报告。我问为什么他不能报告，他回答说他不允许。我希望我记录了那次谈话！后来我收到零售商的一封电子邮件，说明机票已经解决并关闭。这是跨国公司令人作呕的行为。我故意忽略了这篇文章中的名字 - 如果微软的任何人都感兴趣，门票号就足够了。有什么建议？

excel vba excel-vba
2个回答
10
投票

使用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
0
投票

@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按字节复制字节。您可以检查复制到多字段类型的内容，并且可以通过查看字节数组来检查磁盘上的实际内容。希望这可以帮助。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.