Problems calling Function with Argument (Need to pass File name from one function to another)

S

SamatarM

Board Regular
Joined
Nov 13, 2014
Messages
51
I am trying to integrate 2 functions.

I have one sub function which works to loop through all files one by one.

once it has identified the file name.


It should call the function to run, on the opened file.


I can not seem to find a way to pass this on,


I did some reading on calling functions with arguments but when i try this i get a "compile error seperate list or )"


Can you please point me in the right direction?


I have posted the code below:


Code: 
Option Explicit
Option Base 1

Public Const DATASHEET As String = "MDFDATA"
Public Const TABLECONVERSIONSHEET As String = "TABLECONVERSION"
Public Const OPTIONSSHEET As String = "OPTIONS"
Public Const FinalSheet As String = "Final Sheet"
Public lByte_Order As Long                  'byte order
Public lData_Groups As Long                 'number of data groups
Public lChannel_Groups As Long              'number of channel groups
Public lChannels As Long                    'number of channels
Public lTable_offset As Long                'row offset for the conversion table sheet
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
Dim sFile_Name As String                'MDF file name
Dim lFile_Number As Long                'file number
MyFolder = "C:\Users\Mohamed samatar.DSSE-EMEA\Documents\EQVL\Test"
sFile_Name = Dir(MyFolder & "\*.dat")
Do While sFile_Name <> ""
lFile_Number = FreeFile
Open sFile_Name For Binary Access Read Shared As lFile_Number
Call PARSE_MDF


Loop
End Sub
'==================================================================================================
'   PARSE_MDF
'   Main function
'   Returns True if successful
'==================================================================================================
Function PARSE_MDF() As Boolean
    Dim sFile_Name As String                'MDF file name
    Dim lFile_Number As Long                'file number
    
    Dim lData_Groups_Counter As Long        'data groups counter
    Dim lChannel_Groups_Counter As Long     'channel groups counter
    Dim lChannels_Counter As Long           'channels counter
    Dim lRecords As Long                    'number of records in data block
    Dim lRecord_Length As Long              'length of record in data block
    
    Dim lData_Group_Address As Long         'data group address
    Dim lData_Address As Long               'data address
    Dim lChannel_Group_Address As Long      'Channel group address
    Dim lChannel_Address As Long            'Channel address
    
    Dim byCol As Byte                       'column counter for output
    Dim wsData_Sheet As Worksheet           'main worksheet
    Dim wsTable_Conversion_Sheet As Worksheet
    
    Dim rFirst_Signal As Range              'first signal in channel group
    Dim rLast_Signal As Range               'last signal in channel group
    Dim rSignals As Range                   'range of signal names for a channel group
    Application.EnableEvents = False
    
    lTable_offset = 0
    Set wsTable_Conversion_Sheet = Workbooks(ActiveWorkbook.Name).Worksheets(TABLECONVERSIONSHEET)
    Set wsData_Sheet = Workbooks(ActiveWorkbook.Name).Worksheets(DATASHEET)
    
      
    'file selected
    If sFile_Name <> "False" Then
        'clear old data
        wsData_Sheet.Columns.Clear
        wsTable_Conversion_Sheet.Columns.ClearContents
        
        'set headers
        wsData_Sheet.Cells(1, 1).Value = "Signal name"
        wsData_Sheet.Cells(2, 1).Value = "Data type"
        wsData_Sheet.Cells(3, 1).Value = "Lsb"
        wsData_Sheet.Cells(4, 1).Value = "Offset"
        wsData_Sheet.Cells(5, 1).Value = "Bit length"
        wsData_Sheet.Cells(6, 1).Value = "Formula ID"
        wsData_Sheet.Cells(7, 1).Value = "Formula"
        wsData_Sheet.Cells(8, 1).Value = "First Bit position"
        wsData_Sheet.Cells(9, 1).Value = "Table length"
        wsData_Sheet.Cells(10, 1).Value = "Start Row"
        
        'offset columns because of headers
        byCol = 2
        
        'get file number
        lFile_Number = FreeFile
        
        'open file
              
            'check file integrity
            If IDBLOCK(lFile_Number) Then
                      
                'check data exists
                If HDBLOCK(lFile_Number, lData_Group_Address) Then
                    'main iteration for data groups
                    For lData_Groups_Counter = 1 To lData_Groups
                    
                        'check channel group exists
                        If DGBLOCK(lFile_Number, lData_Group_Address, lChannel_Group_Address, lData_Address) Then
                            'channel group iteration
                            For lChannel_Groups_Counter = 1 To lChannel_Groups
          
                                'get channel group data
                                Call CGBLOCK(lFile_Number, lChannel_Group_Address, lChannel_Address, lRecord_Length, lRecords)
                                'set the first signal range in this channel group
                                Set rFirst_Signal = wsData_Sheet.Cells(1, byCol)
                                
                                'channels iteration
                                For lChannels_Counter = 1 To lChannels
                                
                                    'get channel data for each channel
                                    Call CNBLOCK(lFile_Number, lChannel_Address, wsData_Sheet, byCol)
                                    
                                    'excel fudge
                                    If byCol <> 255 Then
                                        byCol = byCol + 1
                                    End If
                                    
                                Next    'lChannels_Counter
         
                                'set the last signal range in this channel group
                                Set rLast_Signal = wsData_Sheet.Cells(1, byCol - 1)
                                
                                'format divider columns
                                wsData_Sheet.Columns(byCol).ColumnWidth = 5
                                wsData_Sheet.Columns(byCol).Interior.ColorIndex = 0
                                wsData_Sheet.Columns(byCol).Interior.Pattern = xlLightUp
                                wsData_Sheet.Columns(byCol).Interior.PatternColorIndex = xlAutomatic
                                
                                'excel fudge
                                If byCol <> 255 Then
                                    'for space between channels
                                    byCol = byCol + 1
                                End If
                                
                            Next    'lChannel_Groups_Counter
                            'get range of signals to get data for
                            Set rSignals = wsData_Sheet.Range(rFirst_Signal, rLast_Signal)
                            'get signal data
                           
                        'no channel data in this data group
                        Else
                            PARSE_MDF = False
                            
                        End If
                    
                    Next    'lData_Groups_Counter
 
                'no data in MDF file
                Else
                    PARSE_MDF = False
                
                End If
            'not a MDF file
            Else
                PARSE_MDF = False
            
            End If
            
        'close file
        Close #lFile_Number
            
        'tidy up sheet
        wsData_Sheet.Rows.EntireRow.AutoFit
        wsData_Sheet.Columns.EntireColumn.AutoFit
        wsData_Sheet.Rows("2:15").EntireRow.Delete
        wsData_Sheet.Columns("A:A").EntireColumn.Delete
        wsData_Sheet.Cells.HorizontalAlignment = xlCenter
                
        'function ends normally
        PARSE_MDF = True
        
    'no file was selected
    Else
        PARSE_MDF = False
        
    End If
    Application.EnableEvents = True
    
End Function
 
Last edited by a moderator:
Sort by date Sort by votes
It calls the first function,
It then seems to stumble on :


If HDBLOCK(lFile_Number, lData_Group_Address) Then
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
What does "stumble on" mean? What happens?
 
Upvote 0
In fact it is here:
Code: 
Function IDBLOCK(lFile_Number As Long) As Boolean
    Dim sTemp As String
    Dim byTemp As Byte
    
    'get file ID
    sTemp = Space(3)
    Get lFile_Number, &H1, sTemp
    'MsgBox "File ID: " + sTemp
    If sTemp = "MDF" Then
        
        'get byte order
        Get lFile_Number, &H19, byTemp
        lByte_Order = byTemp
        Get lFile_Number, &H1A, byTemp
        lByte_Order = lByte_Order + (byTemp * (2 ^ 8))
        'MsgBox "lByte_Order: " + Hex(lByte_Order)
        If lByte_Order <> 0 Then
        
            IDBLOCK = False
            
        Else
            IDBLOCK = True
            
        End If
        
    Else
    
        IDBLOCK = False
    End If
End Function
It skips this instruction and skips to IDBLOCK False and then loops through the next file instead of going through to the next function.

I have previously used this PARSE function on single files and it worked on the exact file I am pointing it to?
 
Last edited by a moderator:
Upvote 0
If you uncomment the MsgBox line, what message does it pop up?
 
Upvote 0
In actual fact It seems to be saying the files are not "MDF"files,

Eventhough they are, I think you have solved the original question.

THank you very mch for that I will try to understand this problem a bit better ad see if I can resolve it.

If I can not isit ok to post in his thread?
 
Upvote 0
It pops up with a blank FILE ID?

TO BE MORE PRECISE:

File ID:

I am assuming the file is not actually been opened?
 
Upvote 0
The file is opened by the line I added to the first function:
Code: 
            Open sFile_Name For Binary Access Read Shared As lFile_Number
 
Upvote 0
Hi Rory, Could the issue be relted to the way the file numbr s passed onto the ID block?
Code: 
Function IDBLOCK(lFile_Number As Long) As Boolean
    Dim sTemp As String
    Dim byTemp As Byte
    
    'get file ID
    sTemp = Space(3)
    Get lFile_Number, &H1, sTemp
    MsgBox "File ID: " + sTemp
    If sTemp = "MDF" Then
It is at this point where it skips to
Code: 
Else
    
        IDBLOCK = False
    End If
End Function
and ends the PARSE function.
 
Last edited by a moderator:
Upvote 0
I don't see how. Is it passing the same number you used to open the file?
 
Upvote 0
In actual fact, I believe it does not think the file type is "MDF" eventhough it is.

That seems to be the issue.

Here is the code working using the GetOpenFile function:

Code: 
 Option Explicit
Option Base 1
Public Const DATASHEET As String = "MDFDATA"
Public Const TABLECONVERSIONSHEET As String = "TABLECONVERSION"
Public Const OPTIONSSHEET As String = "OPTIONS"
Public lByte_Order As Long                  'byte order
Public lData_Groups As Long                 'number of data groups
Public lChannel_Groups As Long              'number of channel groups
Public lChannels As Long                    'number of channels
Public lTable_offset As Long                'row offset for the conversion table sheet
'==================================================================================================
'   PARSE_MDF
'   Main function
'   Returns True if successful
'==================================================================================================
Function PARSE_MDF() As Boolean
    Dim sFile_Name As String                'MDF file name
    Dim lFile_Number As Long                'file number
    
    Dim lData_Groups_Counter As Long        'data groups counter
    Dim lChannel_Groups_Counter As Long     'channel groups counter
    Dim lChannels_Counter As Long           'channels counter
    Dim lRecords As Long                    'number of records in data block
    Dim lRecord_Length As Long              'length of record in data block
    
    Dim lData_Group_Address As Long         'data group address
    Dim lData_Address As Long               'data address
    Dim lChannel_Group_Address As Long      'Channel group address
    Dim lChannel_Address As Long            'Channel address
    
    Dim byCol As Byte                       'column counter for output
    Dim wsData_Sheet As Worksheet           'main worksheet
    Dim wsTable_Conversion_Sheet As Worksheet
    
    Dim rFirst_Signal As Range              'first signal in channel group
    Dim rLast_Signal As Range               'last signal in channel group
    Dim rSignals As Range                   'range of signal names for a channel group
    Application.EnableEvents = False
    
    lTable_offset = 0
    Set wsTable_Conversion_Sheet = Workbooks(ActiveWorkbook.Name).Worksheets(TABLECONVERSIONSHEET)
    Set wsData_Sheet = Workbooks(ActiveWorkbook.Name).Worksheets(DATASHEET)
    
    'get file name
    sFile_Name = Application.GetOpenFilename(",*.*")
    
    'file selected
    If sFile_Name <> "False" Then
        'clear old data
        wsData_Sheet.Columns.Clear
        wsTable_Conversion_Sheet.Columns.ClearContents
        
        'set headers
        wsData_Sheet.Cells(1, 1).Value = "Signal name"
        wsData_Sheet.Cells(2, 1).Value = "Data type"
        wsData_Sheet.Cells(3, 1).Value = "Lsb"
        wsData_Sheet.Cells(4, 1).Value = "Offset"
        wsData_Sheet.Cells(5, 1).Value = "Bit length"
        wsData_Sheet.Cells(6, 1).Value = "Formula ID"
        wsData_Sheet.Cells(7, 1).Value = "Formula"
        wsData_Sheet.Cells(8, 1).Value = "First Bit position"
        wsData_Sheet.Cells(9, 1).Value = "Table length"
        wsData_Sheet.Cells(10, 1).Value = "Start Row"
        
        'offset columns because of headers
        byCol = 2
        
        'get file number
        lFile_Number = FreeFile
        
        'open file
        Open sFile_Name For Binary Access Read Shared As #lFile_Number
            'check file integrity
            If IDBLOCK(lFile_Number) Then
                      
                'check data exists
                If HDBLOCK(lFile_Number, lData_Group_Address) Then
                    'main iteration for data groups
                    For lData_Groups_Counter = 1 To lData_Groups
                    
                        'check channel group exists
                        If DGBLOCK(lFile_Number, lData_Group_Address, lChannel_Group_Address, lData_Address) Then
                            'channel group iteration
                            For lChannel_Groups_Counter = 1 To lChannel_Groups
          
                                'get channel group data
                                Call CGBLOCK(lFile_Number, lChannel_Group_Address, lChannel_Address, lRecord_Length, lRecords)
                                'set the first signal range in this channel group
                                Set rFirst_Signal = wsData_Sheet.Cells(1, byCol)
                                
                                'channels iteration
                                For lChannels_Counter = 1 To lChannels
                                
                                    'get channel data for each channel
                                    Call CNBLOCK(lFile_Number, lChannel_Address, wsData_Sheet, byCol)
                                    
                                    'excel fudge
                                    If byCol <> 255 Then
                                        byCol = byCol + 1
                                    End If
                                    
                                Next    'lChannels_Counter
         
                                'set the last signal range in this channel group
                                Set rLast_Signal = wsData_Sheet.Cells(1, byCol - 1)
                                
                                'format divider columns
                                wsData_Sheet.Columns(byCol).ColumnWidth = 5
                                wsData_Sheet.Columns(byCol).Interior.ColorIndex = 0
                                wsData_Sheet.Columns(byCol).Interior.Pattern = xlLightUp
                                wsData_Sheet.Columns(byCol).Interior.PatternColorIndex = xlAutomatic
                                
                                'excel fudge
                                If byCol <> 255 Then
                                    'for space between channels
                                    byCol = byCol + 1
                                End If
                                
                            Next    'lChannel_Groups_Counter
                            'get range of signals to get data for
                            Set rSignals = wsData_Sheet.Range(rFirst_Signal, rLast_Signal)
                            'get signal data
                            Call GET_SIGNAL_DATA(lFile_Number, rSignals, lRecords, lRecord_Length, lData_Address)
                        'no channel data in this data group
                        Else
                            PARSE_MDF = False
                            
                        End If
                    
                    Next    'lData_Groups_Counter
 
                'no data in MDF file
                Else
                    PARSE_MDF = False
                
                End If
            'not a MDF file
            Else
                PARSE_MDF = False
            
            End If
            
        'close file
        Close #lFile_Number
            
        'tidy up sheet
        wsData_Sheet.Rows.EntireRow.AutoFit
        wsData_Sheet.Columns.EntireColumn.AutoFit
        wsData_Sheet.Rows("2:15").EntireRow.Delete
        wsData_Sheet.Columns("A:A").EntireColumn.Delete
        wsData_Sheet.Cells.HorizontalAlignment = xlCenter
                
        'function ends normally
        PARSE_MDF = True
        
    'no file was selected
    Else
        PARSE_MDF = False
        
    End If
    Application.EnableEvents = True
    
End Function
'==================================================================================================
'   IDBLOCK
'   Gets and checks data from IDBLOCK
'   Returns True if successful
'==================================================================================================
Function IDBLOCK(lFile_Number As Long) As Boolean
    Dim sTemp As String
    Dim byTemp As Byte
    
    'get file ID
    sTemp = Space(3)
    Get lFile_Number, &H1, sTemp
    'MsgBox "File ID: " + sTemp
    If sTemp = "MDF" Then
        
        'get byte order
        Get lFile_Number, &H19, byTemp
        lByte_Order = byTemp
        Get lFile_Number, &H1A, byTemp
        lByte_Order = lByte_Order + (byTemp * (2 ^ 8))
        'MsgBox "lByte_Order: " + Hex(lByte_Order)
        If lByte_Order <> 0 Then
        
            IDBLOCK = False
            
        Else
            IDBLOCK = True
            
        End If
        
    Else
    
        IDBLOCK = False
    End If
End Function
'==================================================================================================
'   HDBLOCK
'   Gets and checks data from HDBLOCK
'   Returns True if successful
'==================================================================================================
Function HDBLOCK(lFile_Number As Long, lData_Group_Address As Long) As Boolean
    
    Dim byTemp As Byte
    
    Get lFile_Number, &H51, byTemp
    lData_Groups = byTemp
    Get lFile_Number, &H52, byTemp
    lData_Groups = lData_Groups + (byTemp * (2 ^ 8))
    'MsgBox "lData_Groups: " + CStr(lData_Groups)
    Get lFile_Number, &H45, lData_Group_Address
    'MsgBox "lData_Group_Address: " + Hex(lData_Group_Address)
                
    If lData_Groups <> 0 And lData_Group_Address <> 0 Then
        HDBLOCK = True
        
    Else
        HDBLOCK = False
                
    End If
    
End Function
'==================================================================================================
'   DGBLOCK
'   Gets and checks data from DGBLOCK
'   Returns True if successful
'==================================================================================================
Function DGBLOCK(lFile_Number As Long, lData_Group_Address As Long, lChannel_Group_Address As Long, lData_Address As Long) As Boolean
    Dim lTemp As Long
    Dim byTemp As Byte
    
    Get lFile_Number, lData_Group_Address + &H5, lTemp
    'MsgBox "Next lData_Group_Address: " + Hex(lTemp)
    
    Get lFile_Number, lData_Group_Address + &H9, lChannel_Group_Address
    'MsgBox "lChannel_Group_Address: " + Hex(lChannel_Group_Address)
    
    Get lFile_Number, lData_Group_Address + &H11, lData_Address
    'MsgBox "lData_Address: " + Hex(lData_Address)
    
    Get lFile_Number, lData_Group_Address + &H15, byTemp
    lChannel_Groups = byTemp
    Get lFile_Number, lData_Group_Address + &H16, byTemp
    lChannel_Groups = lChannel_Groups + (byTemp * (2 ^ 8))
    'MsgBox "lChannel_Groups: " + CStr(lChannel_Groups)
    lData_Group_Address = lTemp
    If lChannel_Groups <> 0 And lChannel_Group_Address <> 0 Then
        DGBLOCK = True
        
    Else
        DGBLOCK = False
            
    End If
    
End Function
'==================================================================================================
'   CGBLOCK
'   Gets and checks data from CGBLOCK
'   Returns True if successful
'==================================================================================================
Function CGBLOCK(lFile_Number As Long, lChannel_Group_Address As Long, lChannel_Address As Long, lRecord_Length As Long, lRecords As Long) As Boolean
    Dim byTemp As Byte
    
    Get lFile_Number, lChannel_Group_Address + &H9, lChannel_Address
    'MsgBox "lChannel_Address: " + Hex(lChannel_Address)
    
    Get lFile_Number, lChannel_Group_Address + &H13, byTemp
    lChannels = byTemp
    Get lFile_Number, lChannel_Group_Address + &H14, byTemp
    lChannels = lChannels + (byTemp * (2 ^ 8))
    'MsgBox "lChannels: " + CStr(lChannels)
    
    Get lFile_Number, lChannel_Group_Address + &H15, byTemp
    lRecord_Length = byTemp
    Get lFile_Number, lChannel_Group_Address + &H16, byTemp
    lRecord_Length = lRecord_Length + (byTemp * (2 ^ 8))
    'MsgBox "lRecord_Length: " + CStr(lRecord_Length)
        
    Get lFile_Number, lChannel_Group_Address + &H17, lRecords
    'MsgBox "lRecords: " + CStr(lRecords)
End Function
'==================================================================================================
'   CNBLOCK
'   Gets and checks data from CNBLOCK
'   Returns True if successful
'==================================================================================================
Function CNBLOCK(lFile_Number As Long, lChannel_Address As Long, wsData_Sheet As Worksheet, byCol As Byte) As Boolean
    Dim sSignal_Name As String
    Dim lNext_Channel_Address As Long
    Dim lConversion_Address As Long
    Dim lFirst_Data As Long
    Dim lBit_Length As Long
    Dim lData_Type As Long
    Dim byTemp As Byte
    
    Get lFile_Number, lChannel_Address + &H5, lNext_Channel_Address
    'MsgBox "lNext_Channel_Address: " + Hex(lNext_Channel_Address)
    Get lFile_Number, lChannel_Address + &H9, lConversion_Address
    'MsgBox "lConversion_Address: " + Hex(lConversion_Address)
    'signal name
    sSignal_Name = Space(32)
    Get lFile_Number, lChannel_Address + &H1B, sSignal_Name
    
    If InStr(1, sSignal_Name, "\") <> 0 Then
        sSignal_Name = Mid(sSignal_Name, 1, InStr(1, sSignal_Name, "\") - 1)
    End If
    
    wsData_Sheet.Cells(1, byCol).Value = sSignal_Name
    
    'first bit data location
    Get lFile_Number, lChannel_Address + &HBB, byTemp
    lFirst_Data = byTemp
    Get lFile_Number, lChannel_Address + &HBC, byTemp
    lFirst_Data = lFirst_Data + (byTemp * (2 ^ 8))
    
    wsData_Sheet.Cells(8, byCol).Value = lFirst_Data
    'bit length
    Get lFile_Number, lChannel_Address + &HBD, byTemp
    lBit_Length = byTemp
    Get lFile_Number, lChannel_Address + &HBE, byTemp
    lBit_Length = lBit_Length + (byTemp * (2 ^ 8))
    wsData_Sheet.Cells(5, byCol).Value = lBit_Length
    'data type
    Get lFile_Number, lChannel_Address + &HBF, byTemp
    lData_Type = byTemp
    Get lFile_Number, lChannel_Address + &HC0, byTemp
    lData_Type = lData_Type + (byTemp * (2 ^ 8))
    wsData_Sheet.Cells(2, byCol).Value = lData_Type
    Call CCBLOCK(lFile_Number, lConversion_Address, wsData_Sheet, byCol)
    
    lChannel_Address = lNext_Channel_Address
End Function
'==================================================================================================
'   CNBLOCK
'   Gets and checks data from CNBLOCK
'   Returns True if successful
'==================================================================================================
Function CCBLOCK(lFile_Number As Long, lConversion_Address As Long, wsData_Sheet As Worksheet, byCol As Byte) As Boolean
    Dim fdOffset As Double
    Dim fdLSB As Double
    Dim fdTemp As Double
    
    Dim byTemp As Byte
    
    Dim lBlock_Length As Long
    Dim lFormula_ID As Long
    Dim lTable_Length As Long
    Dim lCounter As Long
    Dim lText_Address As Long
    Dim lText_Block_Length As Long
    
    Dim sTemp As String
    Dim wsTable_Conversion_Sheet As Worksheet
    
    Set wsTable_Conversion_Sheet = Workbooks(ActiveWorkbook.Name).Worksheets(TABLECONVERSIONSHEET)
    
    sTemp = Space(2)
    Get lFile_Number, lConversion_Address + &H1, sTemp
    'MsgBox "Block Identification: " + sTemp
    
    If sTemp = "CC" Then
    
        Get lFile_Number, lConversion_Address + &H3, byTemp
        lBlock_Length = byTemp
        Get lFile_Number, lConversion_Address + &H4, byTemp
        lBlock_Length = lBlock_Length + (byTemp * (2 ^ 8))
        'MsgBox "lBlock_Length: " + CStr(lBlock_Length)
        
        Get lFile_Number, lConversion_Address + &H2B, byTemp
        lFormula_ID = byTemp
        Get lFile_Number, lConversion_Address + &H2C, byTemp
        lFormula_ID = lFormula_ID + (byTemp * (2 ^ 8))
        wsData_Sheet.Cells(6, byCol).Value = lFormula_ID
        'Vector formula style
        If lFormula_ID = 10 Then
            sTemp = Space(lBlock_Length - &H2F)
            Get lFile_Number, lConversion_Address + &H2F, sTemp
            wsData_Sheet.Cells(7, byCol).Value = sTemp
        'Vector table style
        ElseIf lFormula_ID = 12 Then
            Get lFile_Number, lConversion_Address + &H2D, byTemp
            lTable_Length = byTemp
            Get lFile_Number, lConversion_Address + &H2E, byTemp
            lTable_Length = lTable_Length + (byTemp * (2 ^ 8))
            wsData_Sheet.Cells(9, byCol).Value = lTable_Length
            
            If lTable_offset = 0 Then
                wsData_Sheet.Cells(10, byCol).Value = 1
            Else
                wsData_Sheet.Cells(10, byCol).Value = lTable_offset + 1
            End If
            
            For lCounter = 1 To lTable_Length
                
                Get lFile_Number, lConversion_Address + &H2F + (&H14 * (lCounter - 1)), fdTemp
                wsTable_Conversion_Sheet.Cells(lCounter + lTable_offset, 1).Value = fdTemp
                
                Get lFile_Number, lConversion_Address + &H37 + (&H14 * (lCounter - 1)), fdTemp
                wsTable_Conversion_Sheet.Cells(lCounter + lTable_offset, 2).Value = fdTemp
                
                Get lFile_Number, lConversion_Address + &H3F + (&H14 * (lCounter - 1)), lText_Address
                
                Get lFile_Number, lText_Address + &H3, byTemp
                lText_Block_Length = byTemp
                Get lFile_Number, lText_Address + &H4, byTemp
                lText_Block_Length = lText_Block_Length + (byTemp * (2 ^ 8))
                
                sTemp = Space(lText_Block_Length - 4)
                Get lFile_Number, lText_Address + &H5, sTemp
                wsTable_Conversion_Sheet.Cells(lCounter + lTable_offset, 3).Value = sTemp
                
            Next
            
            lTable_offset = lTable_offset + lCounter
            
        'ETAS text style
        ElseIf lFormula_ID = 65535 Then
        
        'normal LSB, offset style
        Else
           'get offset
           Get lFile_Number, lConversion_Address + &H2F, fdOffset
           wsData_Sheet.Cells(4, byCol).Value = fdOffset
           
           'get lsb
           Get lFile_Number, lConversion_Address + &H37, fdLSB
           wsData_Sheet.Cells(3, byCol).Value = fdLSB
        End If
    
        CCBLOCK = True
        
    Else
        CCBLOCK = False
    
    End If
End Function
'==================================================================================================
'   GET_SIGNAL_DATA
'   Gets data from data block and writes it to excel worksheet
'
'==================================================================================================
Function GET_SIGNAL_DATA(lFile_Number As Long, rSignals As Range, lRecords As Long, lRecord_Length As Long, lData_Address As Long) As Boolean
    Dim lTable_Counter As Long          'counter for table conversion method
    Dim lRecord_Counter As Long         'record counter
    Dim lFlag_Shift_Bits As Long        'flag shift value
    Dim lRedution_Factor As Long        'input data reduction factor
    Dim lRow As Long                    'row position counter
    Dim lSignal_Start As Long           'signal data start point in record
    Dim byTemp As Byte                  'temp data
    Dim iTemp As Integer                'temp data
    Dim lTemp As Long                   'temp data
    Dim lTempLSB As Long                'temp data
    Dim fsTemp As Single                'temp data
    Dim fdTemp As Double                'temp data
    Dim sTemp As String                 'temp data
    
    Dim rSignal As Range                'individual signal range
    
    Dim wsOptions_Sheet As Worksheet    'options worksheet
    Dim wsTable_Conversion_Sheet As Worksheet   'table conversion method worksheet
    
    'set worksheets
    Set wsOptions_Sheet = Workbooks(ActiveWorkbook.Name).Worksheets(OPTIONSSHEET)
    Set wsTable_Conversion_Sheet = Workbooks(ActiveWorkbook.Name).Worksheets(TABLECONVERSIONSHEET)
    
    'set row offset
    lRow = 15
    lFlag_Shift_Bits = 0
    
    'set reduction factor from options sheet
    lRedution_Factor = wsOptions_Sheet.Range("B6").Value
    'iteration for each record
    For lRecord_Counter = 1 To lRecords * lRecord_Length Step lRecord_Length * (lRedution_Factor Or &H1)
    
        'iteration for each signal
        For Each rSignal In rSignals.Columns
            
            'set start byte position for this signal
            lSignal_Start = (rSignal.Offset(7, 0).Value / 8) + lRecord_Counter
    
            'unsigned data type
            If rSignal.Offset(1, 0).Value = 0 Then
                'linear conversion method
                If rSignal.Offset(5, 0).Value = 0 Then
                
                    'unsigned flag record
                    If rSignal.Offset(4, 0).Value = 1 Then
                        
                        'get byte that contains flag
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                                    
                        'shift the flag byte so that the flag we want is in the least significant bit
                        If lFlag_Shift_Bits <> 0 Then
                            byTemp = byTemp \ (2 ^ lFlag_Shift_Bits)
                        End If
                        
                        'strip all other data and write flag value
                        rSignal.Offset(lRow, 0).Value = byTemp And &H1
                        
                        'if the next signal is not a flag or last flag has been read out of current byte clear shift value
                        'flag function assumes flags are stored in logical order
                        'function will not work if they are not
                        If rSignal.Offset(4, 1).Value <> 1 Or lFlag_Shift_Bits >= 7 Then
                            lFlag_Shift_Bits = 0
                        Else
                            lFlag_Shift_Bits = lFlag_Shift_Bits + 1
                        End If
                
                    'unsigned byte record
                    ElseIf rSignal.Offset(4, 0).Value = 8 Then
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        rSignal.Offset(lRow, 0).Value = (byTemp * rSignal.Offset(2, 0).Value) + rSignal.Offset(3, 0).Value
    
                    'unsigned word record
                    ElseIf rSignal.Offset(4, 0).Value = 16 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        lTemp = byTemp
                        
                        Get lFile_Number, lData_Address + lSignal_Start + 1, byTemp
                        lTemp = lTemp + (byTemp * (2 ^ 8))
                        
                        rSignal.Offset(lRow, 0).Value = (lTemp * rSignal.Offset(2, 0).Value) + rSignal.Offset(3, 0).Value
                    
                    'unsigned dword record
                    ElseIf rSignal.Offset(4, 0).Value = 32 Then
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        rSignal.Offset(lRow, 0).Value = (lTemp * rSignal.Offset(2, 0).Value) + rSignal.Offset(3, 0).Value
    
                    'unsigned qword record
                    ElseIf rSignal.Offset(4, 0).Value = 64 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        fdTemp = lTemp
                    
                        Get lFile_Number, lData_Address + lSignal_Start + 4, lTemp
                        fdTemp = fdTemp + (lTemp * (2 ^ 32))
                        
                        rSignal.Offset(lRow, 0).Value = (fdTemp * rSignal.Offset(2, 0).Value) + rSignal.Offset(3, 0).Value
                    
                    End If
                'formula conversion method
                ElseIf rSignal.Offset(5, 0).Value = 10 Then
                
                    'unsigned byte record
                    If rSignal.Offset(4, 0).Value = 8 Then
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(byTemp, rSignal.Offset(6, 0).Value)
                    'unsigned word record
                    ElseIf rSignal.Offset(4, 0).Value = 16 Then
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        lTemp = byTemp
                        Get lFile_Number, lData_Address + lSignal_Start + 1, byTemp
                        lTemp = lTemp + (byTemp * (2 ^ 8))
                        
                        rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(lTemp, rSignal.Offset(6, 0).Value)
                    'unsigned dword record
                    ElseIf rSignal.Offset(4, 0).Value = 32 Then
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(lTemp, rSignal.Offset(6, 0).Value)
                
                    'unsigned qword record
                    ElseIf rSignal.Offset(4, 0).Value = 64 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        fdTemp = lTemp
                    
                        Get lFile_Number, lData_Address + lSignal_Start + 4, lTemp
                        fdTemp = fdTemp + (lTemp * (2 ^ 32))
                        
                        rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(fdTemp, rSignal.Offset(6, 0).Value)
                                    
                    End If
                'table conversion method
                ElseIf rSignal.Offset(5, 0).Value = 12 Then
                    
                    'unsigned byte record
                    If rSignal.Offset(4, 0).Value = 8 Then
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        For lTable_Counter = rSignal.Offset(9, 0).Value + 1 To (rSignal.Offset(9, 0).Value + rSignal.Offset(8, 0).Value)
                        
                            If byTemp >= wsTable_Conversion_Sheet.Cells(lTable_Counter, 1).Value And byTemp <= wsTable_Conversion_Sheet.Cells(lTable_Counter, 2).Value Then
                            
                                rSignal.Offset(lRow, 0).Value = wsTable_Conversion_Sheet.Cells(lTable_Counter, 3).Value
                        
                                Exit For
                                
                            End If
                            
                        Next
                        
                    'unsigned word record
                    ElseIf rSignal.Offset(4, 0).Value = 16 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        lTemp = byTemp
                        
                        Get lFile_Number, lData_Address + lSignal_Start + 1, byTemp
                        lTemp = lTemp + (byTemp * (2 ^ 8))
                        For lTable_Counter = rSignal.Offset(9, 0).Value + 1 To (rSignal.Offset(9, 0).Value + rSignal.Offset(8, 0).Value)
                        
                            If lTemp >= wsTable_Conversion_Sheet.Cells(lTable_Counter, 1).Value And lTemp <= wsTable_Conversion_Sheet.Cells(lTable_Counter, 2).Value Then
                            
                                rSignal.Offset(lRow, 0).Value = wsTable_Conversion_Sheet.Cells(lTable_Counter, 3).Value
                        
                                Exit For
                                
                            End If
                            
                        Next
                    'unsigned dword record
                    ElseIf rSignal.Offset(4, 0).Value = 32 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        
                        For lTable_Counter = rSignal.Offset(9, 0).Value + 1 To (rSignal.Offset(9, 0).Value + rSignal.Offset(8, 0).Value)
                        
                            If lTemp >= wsTable_Conversion_Sheet.Cells(lTable_Counter, 1).Value And lTemp <= wsTable_Conversion_Sheet.Cells(lTable_Counter, 2).Value Then
                            
                                rSignal.Offset(lRow, 0).Value = wsTable_Conversion_Sheet.Cells(lTable_Counter, 3).Value
                        
                                Exit For
                                
                            End If
                            
                        Next
                        
                    'unsigned qword record
                    ElseIf rSignal.Offset(4, 0).Value = 64 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        fdTemp = lTemp
                    
                        Get lFile_Number, lData_Address + lSignal_Start + 4, lTemp
                        fdTemp = fdTemp + (lTemp * (2 ^ 32))
                          
                        For lTable_Counter = rSignal.Offset(9, 0).Value + 1 To (rSignal.Offset(9, 0).Value + rSignal.Offset(8, 0).Value)
                        
                            If fdTemp >= wsTable_Conversion_Sheet.Cells(lTable_Counter, 1).Value And fdTemp <= wsTable_Conversion_Sheet.Cells(lTable_Counter, 2).Value Then
                            
                                rSignal.Offset(lRow, 0).Value = wsTable_Conversion_Sheet.Cells(lTable_Counter, 3).Value
                        
                                Exit For
                                
                            End If
                            
                        Next
                        
                    End If
                    
                'no conversion method
                ElseIf rSignal.Offset(5, 0).Value = 65535 Then
            
                    'unsigned byte record
                    If rSignal.Offset(4, 0).Value = 8 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        rSignal.Offset(lRow, 0).Value = byTemp
                    'unsigned word record
                    ElseIf rSignal.Offset(4, 0).Value = 16 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        lTemp = byTemp
                        
                        Get lFile_Number, lData_Address + lSignal_Start + 1, byTemp
                        lTemp = lTemp + (byTemp * (2 ^ 8))
                        
                        rSignal.Offset(lRow, 0).Value = lTemp
                        
                    'unsigned dword record
                    ElseIf rSignal.Offset(4, 0).Value = 32 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        rSignal.Offset(lRow, 0).Value = lTemp
                        
                    'unsigned qword record
                    ElseIf rSignal.Offset(4, 0).Value = 64 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        fdTemp = lTemp
                    
                        Get lFile_Number, lData_Address + lSignal_Start + 4, lTemp
                        fdTemp = fdTemp + (lTemp * (2 ^ 32))
                        
                        rSignal.Offset(lRow, 0).Value = fdTemp
                        
                        
                    End If
                    
                End If
   
            'signed data type
            ElseIf rSignal.Offset(1, 0).Value = 1 Then
            
                'formula conversion method
                If rSignal.Offset(5, 0).Value = 10 Then
                
                    'signed byte record
                    If rSignal.Offset(4, 0).Value = 8 Then
                        Get lFile_Number, lData_Address + lSignal_Start, byTemp
                        If byTemp <= &H7F Then
                            rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(byTemp, rSignal.Offset(6, 0).Value)
                        
                        'negative number
                        Else
                            fdTemp = ((byTemp Xor &HFF) + 1) * -1
                            rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(fdTemp, rSignal.Offset(6, 0).Value)
                        End If
                    'signed word record
                    ElseIf rSignal.Offset(4, 0).Value = 16 Then
                    
                        Get lFile_Number, lData_Address + lSignal_Start, iTemp
                        rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(iTemp, rSignal.Offset(6, 0).Value)
                    'signed dword record
                    ElseIf rSignal.Offset(4, 0).Value = 32 Then
                        Get lFile_Number, lData_Address + lSignal_Start, lTemp
                        If lTemp <= &H7FFFFFFF Then
                            rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(lTemp, rSignal.Offset(6, 0).Value)
                        
                        'negative number
                        Else
                            fdTemp = ((lTemp Xor &HFFFFFFFF) + 1) * -1
                            rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(fdTemp, rSignal.Offset(6, 0).Value)
                        End If
                        
                    'signed qdword record
                    ElseIf rSignal.Offset(4, 0).Value = 64 Then
                        Get lFile_Number, lData_Address + lSignal_Start, lTempLSB
                        Get lFile_Number, lData_Address + lSignal_Start + 4, lTemp
                        If lTemp <= &H7FFFFFFF Then
                        
                            fdTemp = lTempLSB + (lTemp * (2 ^ 32))
                            rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(fdTemp, rSignal.Offset(6, 0).Value)
                        
                        'negative number
                        Else
                            lTempLSB = (lTempLSB Xor &HFFFFFFFF) + 1
                            lTemp = (lTemp Xor &HFFFFFFFF)
                            fdTemp = (lTempLSB + (lTemp * (2 ^ 32))) * -1
                            rSignal.Offset(lRow, 0).Value = FORMULA_CONVERSION(fdTemp, rSignal.Offset(6, 0).Value)
                        End If
                        
                        
                        
                    End If
            
                End If
            
            'float data type
            ElseIf rSignal.Offset(1, 0).Value = 2 Or rSignal.Offset(1, 0).Value = 3 Then
            
                'single precision float record
                If rSignal.Offset(4, 0).Value = 32 Then
                
                    Get lFile_Number, lData_Address + lSignal_Start, fsTemp
                    rSignal.Offset(lRow, 0).Value = (fsTemp * rSignal.Offset(2, 0).Value) + rSignal.Offset(3, 0).Value
                
                'double precision float record
                ElseIf rSignal.Offset(4, 0).Value = 64 Then
                
                    Get lFile_Number, lData_Address + lSignal_Start, fdTemp
                    rSignal.Offset(lRow, 0).Value = (fdTemp * rSignal.Offset(2, 0).Value) + rSignal.Offset(3, 0).Value
                    
                End If
                
            'string data type
            ElseIf rSignal.Offset(1, 0).Value = 7 Then
            
                'no conversion method
                If rSignal.Offset(5, 0).Value = 65535 Then
            
                    sTemp = Space((rSignal.Offset(4, 0).Value) / 8)
                    Get lFile_Number, lData_Address + lSignal_Start, sTemp
                    rSignal.Offset(lRow, 0).Value = sTemp
                End If
                
            End If
            
        Next    'rSignal
        
        'next row
        lRow = lRow + 1
        
    Next    'lRecord_Counter
End Function
'==================================================================================================
'   FORMULA_CONVERSION
'
'   Returns the output of the formula
'==================================================================================================
Function FORMULA_CONVERSION(lArgument As Variant, sFormula As String) As Double
    Dim fdLSB As Double
    Dim fdOffset As Double
    Dim fdExponant As Double
    
    Dim sTemp As String
    
    FORMULA_CONVERSION = 0
    
    'formula in the form n1*x+n2
    If IsNumeric(Left(sFormula, 1)) Then
    
        If InStr(1, sFormula, "*") <> 0 Then
 
            fdLSB = CDbl(Mid(sFormula, 1, InStr(1, sFormula, "*") - 1))
            
            If InStr(1, sFormula, "+") <> 0 Then
                fdOffset = CDbl(Right(sFormula, Len(sFormula) - InStr(1, sFormula, "+")))
                FORMULA_CONVERSION = (fdLSB * lArgument) + fdOffset
                
            ElseIf InStr(1, sFormula, "-") <> 0 Then
                fdOffset = CDbl(Right(sFormula, Len(sFormula) - InStr(1, sFormula, "-")))
                FORMULA_CONVERSION = (fdLSB * lArgument) - fdOffset
            
            End If
            
        End If
        
    'formula in the form (x-n2)/(2^n1)
    ElseIf Left(sFormula, 1) = "(" Then
        If InStr(1, sFormula, ")") <> 0 Then
            
            fdOffset = CDbl(Mid(sFormula, 3, InStr(1, sFormula, ")") - 3))
            If InStr(1, sFormula, "^") <> 0 Then
            
                fdExponant = CDbl(Mid(sFormula, InStr(1, sFormula, "^") + 1, Len(sFormula) - InStr(1, sFormula, "^")))
                FORMULA_CONVERSION = (lArgument + fdOffset) / (2 ^ fdExponant)
                
            End If
        End If
        
    End If
    
End Function
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Extracting & copying both cell data and file name from one workbook to another with VBA
2
Replies
10
Views
5K
NdNoviceHlp
NdNoviceHlp
K
  • Question Question
Help copying a specific named sheet from multiple workbooks onto one sheet in another workbook?
Replies
2
Views
1K
vw412
V
X
  • Solved
How do I get a file name and row number from one excel workbook to another?
Replies
3
Views
690
DanteAmor
DanteAmor
S
  • Question Question
How to edit all queries/connections from one delimiter to another?
Replies
1
Views
1K
Sam Hamels
S
S
  • Question Question
Loop through all files in a directory - PLEASE HELP!
Replies
3
Views
486
venkat1926
V

Forum statistics

Threads
1,225,238
Messages
6,183,776
Members
453,189
Latest member
Grant I

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top