如何从字节数组提取还原VBA Date？读取固定长度二进制文件遇问题

已确认以下VBA代码可正常运行：

Dim mydate As Date
mydate = Date
Open "C:\Windows\Temp\dlctest.data" For Binary Access Write As #1
Put #1, , mydate
Close #1
Open "C:\Windows\Temp\dlctest.data" For Binary Access Read As #1
Get #1, , mydate
Close #1
MsgBox "MyDate = " & mydate

但实际需处理的第三方生成文件包含多条目，每条目含多个日期、时间、小数字段及单字节字符字段：

• 文件头固定94字节
• 后续每个条目固定329字节

需求是先读取保存文件头，再完整读取每个条目后按需解析字段，但遇到两个问题：

1. 如何从字节数组中提取二进制日期并还原为有效的VBA Date？
2. 测试时创建了以下Type块，但读取文件后所有字节数组为空，即使初始化后仍无效，请问当前方法存在什么问题，或更好的读取方式是什么？

Private Type schedulerHeader    ' reclen = 94
    HeaderVersion(25 - 1) As Byte
    HeaderFiller1(69 - 1) As Byte
End Type
Private Type schedulerEntry     ' reclen = 329
    EntryFiller1(6 - 1)   As Byte
    EntryName(100 - 1)    As Byte
    EntryEvent(8 - 1)     As Byte
    EntryBegStamp(15 - 1) As Byte
    EntryOptions(7 - 1)   As Byte
    EntryFiller2(14 - 1)  As Byte
    EntryRunStamp(15 - 1) As Byte
    EntryEndStamp(15 - 1) As Byte
    EntryNxtStamp(15 - 1) As Byte
    EntryFiller3(126 - 1) As Byte
    EntryTag(8 - 1)       As Byte
End Type

1. 从字节数组提取并还原VBA Date #

VBA的Date本质是8字节双精度浮点数（OLE自动化日期），处理分两种情况：

• 如果第三方日期是OLE格式：直接把字节数组转成双精度后转Date，需要用到内存复制API：

  ' 先声明API（放在模块顶部）
  Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
  
  ' 转换逻辑
  Dim dateBytes(7) As Byte ' 存储日期的8字节数组
  Dim dateValue As Double
  Dim targetDate As Date
  CopyMemory dateValue, dateBytes(0), 8
  targetDate = CDate(dateValue)
  

• 如果是自定义格式：比如拆分的年、月、日、时、分、秒字节，需按文件规则拼接：

  ' 示例：假设前2字节年，1字节月，1字节日，1字节时，1字节分，1字节秒
  Dim yearVal As Integer, monthVal As Byte, dayVal As Byte
  Dim hourVal As Byte, minVal As Byte, secVal As Byte
  Dim targetDate As Date
  
  CopyMemory yearVal, dateBytes(0), 2
  monthVal = dateBytes(2)
  dayVal = dateBytes(3)
  hourVal = dateBytes(4)
  minVal = dateBytes(5)
  secVal = dateBytes(6)
  
  targetDate = DateSerial(yearVal, monthVal, dayVal) + TimeSerial(hourVal, minVal, secVal)
  

2. Type块读取无效的问题及解决方法 #

当前代码的核心问题是Type声明的字节数与实际文件不匹配，加上可能的读取逻辑错误，导致数据错位为空：

问题1：Type数组长度计算错误 #

原Type中HeaderVersion(25-1)是24字节，HeaderFiller1(69-1)是68字节，总和92字节，与注释的94字节不符，直接导致读取错位。必须严格按实际字节数声明数组（数组下标从0开始，长度=目标字节数-1）：

Private Type schedulerHeader    ' 总字节数=94
    HeaderVersion(24) As Byte ' 0到24共25字节
    HeaderFiller1(68) As Byte ' 0到68共69字节，25+69=94
End Type
Private Type schedulerEntry     ' 总字节数=329
    EntryFiller1(5)   As Byte ' 6字节
    EntryName(99)    As Byte ' 100字节
    EntryEvent(7)     As Byte ' 8字节
    EntryBegStamp(14) As Byte ' 15字节
    EntryOptions(6)   As Byte '7字节
    EntryFiller2(13)  As Byte '14字节
    EntryRunStamp(14) As Byte '15字节
    EntryEndStamp(14) As Byte '15字节
    EntryNxtStamp(14) As Byte '15字节
    EntryFiller3(125) As Byte '126字节
    EntryTag(7)       As Byte '8字节
    ' 计算总和：6+100+8+15+7+14+15+15+15+126+8=329
End Type

问题2：正确的读取逻辑 #

修正Type后，用Get语句直接读取Type变量，同时确保文件指针位置正确：

Dim header As schedulerHeader
Dim entry As schedulerEntry
Dim entryName As String

Open "YourFilePath" For Binary Access Read As #1
    ' 读取文件头
    Get #1, , header
    ' 循环读取所有条目
    Do While Not EOF(1)
        Get #1, , entry
        ' 处理单字节字符字段（转Unicode并截断空字符）
        entryName = StrConv(entry.EntryName, vbUnicode)
        entryName = Left(entryName, InStr(entryName, vbNullChar) - 1)
        ' 处理日期等其他字段
    Loop
Close #1

备选方案：字节数组转Type（解决对齐问题） #

如果第三方文件是紧凑无字节对齐的，VBA默认的Type对齐可能导致读取错误，可先读取到字节数组再转Type：

' 读取文件头到字节数组
Dim headerBytes(93) As Byte ' 0到93共94字节
Get #1, , headerBytes
' 转成Type变量
Dim header As schedulerHeader
CopyMemory header, headerBytes(0), 94

内容的提问来源于stack exchange，提问作者Dave Clark