終于搞定了, 用VBA直接讀取Perkin Elmer二進制*.sp檔案中的資料

Option Explicit

'Demonstration routine

Sub spload()

'[data, xAxis, misc] =

' Reads in spectra from PerkinElmer block structured files.

' This version supports 'Spectrum' SP files.

' Note that earlier 'Data Manager' formats are not supported.

'

' [data, xAxis, misc] = spload(filename):

'   data:  1D array of doubles

'   xAxis: vector for abscissa (e.g. Wavenumbers).

'   misc: miscellanous information in name,value pairs

' Copyright (C)2009

' Kevin z. Chen

'

' History

' 2009-9-19     Initial version

' Block IDs

Dim sFilename As String

Dim iFileNum As Integer, lFileLen As Long

Dim vThisBlock As Variant, lThisBlock As Long, vFileData As Variant

' convert variable types between VBA get and Matlab fread

Dim uchar As Byte

Dim unchar(0 To 43) As String

Dim int16 As Integer

Dim int32 As Long

Dim double_ As Double

Dim wavenumber(0 To 3550) As Double

Dim absorbance(0 To 3550) As Double

Dim WavenumberIndex As Integer

Dim AbsorbanceIndex As Integer

Dim DSet2DC1DIBlock As Integer

Dim HistoryRecordBlock  As Integer

Dim InstrHdrHistoryRecordBlock  As Integer

Dim InstrumentHeaderBlock   As Integer

Dim IRInstrumentHeaderBlock As Integer

Dim UVInstrumentHeaderBlock As Integer

Dim FLInstrumentHeaderBlock As Integer

Dim DataSetDataTypeMember   As Integer

Dim DataSetAbscissaRangeMember  As Integer

Dim DataSetOrdinateRangeMember  As Integer

Dim DataSetIntervalMember   As Integer

Dim DataSetNumPointsMember  As Integer

Dim DataSetSamplingMethodMember As Integer

Dim DataSetXAxisLabelMember As Integer

Dim DataSetYAxisLabelMember As Integer

Dim DataSetXAxisUnitTypeMember  As Integer

Dim DataSetYAxisUnitTypeMember  As Integer

Dim DataSetFileTypeMember   As Integer

Dim DataSetDataMember   As Integer

Dim DataSetNameMember   As Integer

Dim DataSetChecksumMember   As Integer

Dim DataSetHistoryRecordMember  As Integer

Dim DataSetInvalidRegionMember  As Integer

Dim DataSetAliasMember  As Integer

Dim DataSetVXIRAccyHdrMember    As Integer

Dim DataSetVXIRQualHdrMember    As Integer

Dim DataSetEventMarkersMember   As Integer

Dim ShortType   As Integer

Dim UShortType  As Integer

Dim IntType As Integer

Dim UIntType    As Integer

Dim LongType    As Integer

Dim BoolType    As Integer

Dim CharType    As Integer

Dim CvCoOrdPointType    As Integer

Dim StdFontType As Integer

Dim CvCoOrdDimensionType    As Integer

Dim CvCoOrdRectangleType    As Integer

Dim RGBColorType    As Integer

Dim CvCoOrdRangeType    As Integer

Dim DoubleType  As Integer

Dim CvCoOrdType As Integer

Dim ULongType   As Integer

Dim PeakType    As Integer

Dim CoOrdType   As Integer

Dim RangeType   As Integer

Dim CvCoOrdArrayType    As Integer

Dim EnumType    As Integer

Dim LogFontType As Integer

DSet2DC1DIBlock = 120

HistoryRecordBlock = 121

InstrHdrHistoryRecordBlock = 122

InstrumentHeaderBlock = 123

IRInstrumentHeaderBlock = 124

UVInstrumentHeaderBlock = 125

FLInstrumentHeaderBlock = 126

' Data member IDs

DataSetDataTypeMember = -29839

DataSetAbscissaRangeMember = -29838

DataSetOrdinateRangeMember = -29837

DataSetIntervalMember = -29836

DataSetNumPointsMember = -29835

DataSetSamplingMethodMember = -29834

DataSetXAxisLabelMember = -29833

DataSetYAxisLabelMember = -29832

DataSetXAxisUnitTypeMember = -29831

DataSetYAxisUnitTypeMember = -29830

DataSetFileTypeMember = -29829

DataSetDataMember = -29828

DataSetNameMember = -29827

DataSetChecksumMember = -29826

DataSetHistoryRecordMember = -29825

DataSetInvalidRegionMember = -29824

DataSetAliasMember = -29823

DataSetVXIRAccyHdrMember = -29822

DataSetVXIRQualHdrMember = -29821

DataSetEventMarkersMember = -29820

'Type code IDs

ShortType = 29999

UShortType = 29998

IntType = 29997

UIntType = 29996

LongType = 29995

BoolType = 29988

CharType = 29987

CvCoOrdPointType = 29986

StdFontType = 29985

CvCoOrdDimensionType = 29984

CvCoOrdRectangleType = 29983

RGBColorType = 29982

CvCoOrdRangeType = 29981

DoubleType = 29980

CvCoOrdType = 29979

ULongType = 29978

PeakType = 29977

CoOrdType = 29976

RangeType = 29975

CvCoOrdArrayType = 29974

EnumType = 29973

LogFontType = 29972

Dim innerCode As Integer

Dim x0 As Double

Dim xEnd As Double

Dim xDelta As Double

Dim xLen As Long

Dim xLabel() As Byte

Dim length As Integer

Dim yLabel() As Byte

Dim alias() As Byte

Dim OriginalName() As Byte

Dim data() As Double

'Dim xLength As Integer

Dim offset() As Byte

Dim ucharIndex As Integer

Dim uncharIndex As Integer

Dim description As String

Dim i, j, k, m, n, p As Integer

Dim BlockID As Integer

Dim BlockSize As Long

Dim position As Long

Dim iCountLoop As Long

position = 1

iCountLoop = 0

sFilename = "D:/CalibratedSpectra/5.22.sp"

Debug.Print sFilename

    On Error GoTo ErrFailed

    If Len(Dir$(sFilename)) > 0 And Len(sFilename) > 0 Then

        iFileNum = FreeFile

        Open sFilename For Binary Access Read As #iFileNum

        'lFileLen = LOF(iFileNum)

        WavenumberIndex = 0

        AbsorbanceIndex = 0

        For ucharIndex = 0 To 43

         Get #iFileNum, , uchar

                  position = position + 1

                  Debug.Print "Current Pointer:" & position

                  Debug.Print "standard Pointer:" & Seek(iFileNum)

         unchar(ucharIndex) = uchar

        Next ucharIndex

        ' determine the fomart

            If Chr(unchar(0)) & Chr(unchar(1)) & Chr(unchar(2)) & Chr(unchar(3)) <> "PEPE" Then

            MsgBox "The file " & sFilename & " is not desired Perkin Elmer *.sp binary spectral file."

            Exit Sub

            End If

Debug.Print "The first 4 characters are: " & Chr(unchar(0)) & Chr(unchar(1)) & Chr(unchar(2)) & Chr(unchar(3))

description = ""

For ucharIndex = 4 To 43

description = description & Chr(unchar(ucharIndex))

Next ucharIndex

Debug.Print "The description of the file is: " & description

'xLen = int32(0)

        Do

        iCountLoop = iCountLoop + 1

        If Seek(iFileNum) <= 50 Then

        Debug.Print " Enter the Do-while Loop"

        End If

'            lThisBlock = lThisBlock + 1

        Get #iFileNum, , int16

        position = position + 2

         BlockID = int16

         If Seek(iFileNum) <= 52 Then

        Debug.Print "Current Pointer:" & position

        Debug.Print "standard Pointer:" & Seek(iFileNum)

        Debug.Print "BlockID is: " & BlockID

          End If

        Get #iFileNum, , int32

        position = position + 4

        BlockSize = int32

        If Seek(iFileNum) <= 56 Then

        Debug.Print "Current Pointer:" & position

        Debug.Print "standard Pointer:" & Seek(iFileNum)

        Debug.Print "Block size is: " & BlockSize

        End If

        If EOF(iFileNum) = True Then

        Exit Do

        End If

           Select Case BlockID

                            Case DSet2DC1DIBlock

                            '% Wrapper block.  Read nothing.

                               Debug.Print " -----------------Case DSet2DC1DIBlock; Read Nothing-----------------"

                               Debug.Print "standard Pointer:" & Seek(iFileNum)

                            Case DataSetAbscissaRangeMember

                             Debug.Print " -----------------Case DataSetAbscissaRangeMember-----------------"

                                Get #iFileNum, , innerCode

                                position = position + 2

                                Debug.Print "Current Pointer:" & position

                                Debug.Print "standard Pointer:" & Seek(iFileNum)

                                '%_ASSERTE(CvCoOrdRangeType == nInnerCode)

                                Get #iFileNum, , x0

                                position = position + 8

                                Debug.Print "Current Pointer:" & position

                                Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , xEnd

                                position = position + 8

                                Debug.Print "Current Pointer:" & position

                                Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Debug.Print "innerCode is: " & innerCode

                                Debug.Print "x0 is: " & x0

                                Debug.Print "xEnd is: " & xEnd

                            Case DataSetIntervalMember

                               Debug.Print " -----------------Case DataSetIntervalMember-----------------"

                                Get #iFileNum, , innerCode

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , xDelta

                                   position = position + 8

                                   Debug.Print "Current Pointer:" & position

                                   Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Debug.Print "innerCode is: " & innerCode

                                Debug.Print "xDelta is: " & xDelta

                            Case DataSetNumPointsMember

                               Debug.Print " -----------------Case DataSetNumPointsMember-----------------"

                                Get #iFileNum, , innerCode

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , xLen

                                    position = position + 4

                                    Debug.Print "Current Pointer:" & position

                                    Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Debug.Print "innerCode is: " & innerCode

                                Debug.Print "xDelta is: " & xLen

                            Case DataSetXAxisLabelMember

                               Debug.Print " -----------------Case DataSetXAxisLabelMember-----------------"

                                Get #iFileNum, , innerCode

                                    position = position + 2

                                    Debug.Print "Current Pointer:" & position

                                    Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , length

                                      position = position + 2

                                      Debug.Print "Current Pointer:" & position

                                      Debug.Print "standard Pointer:" & Seek(iFileNum)

                                ReDim xLabel(0 To length - 1) As Byte 'String

                                'For i = 0 To length - 1

                                  Get #iFileNum, , xLabel

                                  position = position + length

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                 'Debug.Print xLabel

                                'Next i

                            Case DataSetYAxisLabelMember

                             Debug.Print " -----------------Case DataSetYAxisLabelMember-----------------"

                                Get #iFileNum, , innerCode

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , length

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                              ReDim yLabel(0 To length - 1) As Byte 'String

                               ' For j = 0 To length - 1

                                 Get #iFileNum, , yLabel

                                   position = position + length

                                   Debug.Print "Current Pointer:" & position

                                   Debug.Print "standard Pointer:" & Seek(iFileNum)

                              '  Next j

                            Case DataSetAliasMember

                             Debug.Print " -----------------Case DataSetAliasMember-----------------"

                                Get #iFileNum, , innerCode

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , length

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                ReDim alias(0 To length - 1) As Byte 'String

                               ' For k = 0 To length - 1

                                Get #iFileNum, , alias

                                  position = position + length

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                'Next k

                            Case DataSetNameMember

                             Debug.Print " -----------------Case DataSetNameMember-----------------"

                                Get #iFileNum, , innerCode

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , length

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                ReDim OriginalName(0 To length - 1) As Byte

                                'For m = 0 To length - 1

                                  Get #iFileNum, , OriginalName

                                    position = position + length

                                'Next m

                            Case DataSetDataMember

                            Debug.Print " -----------------Case DataSetDataMember -----------------"

                                Get #iFileNum, , innerCode

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                Get #iFileNum, , length

                                  position = position + 2

                                  Debug.Print "Current Pointer:" & position

                                  Debug.Print "standard Pointer:" & Seek(iFileNum)

                                '% innerCode should be CvCoOrdArrayType

                                '% length should be xLen * 8

                                If xLen = 0 Then

                                    xLen = length / 8

                                End If

                                ReDim data(0 To xLen - 1) As Double

                                Dim size As Long

                                size = xLen

                                'For n = 0 To xLen - 1

                                 Get #iFileNum, , data

                                 'ActiveWorkbook.Sheets("data").cell("a1") = data(200)

                                 'Debug.Print "****************worksheet data input finished!!"

                                   position = position + length

                                   Debug.Print "Current Pointer:" & position

                                   Debug.Print "standard Pointer:" & Seek(iFileNum)

                                'Next n

                            Case Else

                            Debug.Print " +++++++++++++++++Case Else+++++++++++++++++++++++"

                                  Seek #iFileNum, position + BlockSize

                                  position = position + BlockSize

                               Debug.Print "Current Pointer:" & position

                               Debug.Print "standard Pointer:" & Seek(iFileNum)

                               Debug.Print "position + BlockSize is: " & (position + BlockSize)

            End Select

            If iCountLoop >= 3000 Then

            Exit Sub

            End If

        Loop While EOF(iFileNum) = False

        Close iFileNum

    Else

        Exit Sub

    End If

If xLen = 0 Then

   MsgBox "The file does not contain spectral data."

    Exit Sub

End If

Debug.Print "------------ " & sFilename & " data importing finished.------------"

Debug.Print "Now display the data"

'Debug.Print "--------------------      -----------     -----------    ------------"

Dim index As Integer

'ActiveWorkbook.Sheets(1).cell("a1") = data(200)

For index = 0 To size - 1

'Debug.Print "data(" & index & ") is: " & data(index)

Debug.Print data(index)

index = index + 1

Next 'index

Debug.Print "--------------------      -----------     -----------    ------------"

' Expand the axes specifications into vectors

'wavenumber= x0: xDelta: xEnd

' Return the other details as name,value pairs

'misc(1,:) = {'xLabel', xLabel}

'misc(2,:) = {'yLabel', yLabel}

'misc(3,:) = {'alias', alias}

'misc(4,:) = {'original name', originalName}

ErrFailed:

    Close iFileNum

    Debug.Print Err.description

End Sub