Help with fixing a '52' error bad file name

mrb323 · Dec 3, 2010

Hello,
I'm a student and I'm currently trying to help out on a project that was originally written in VB 5.0 and needs to upgraded to work with newer OS. I've tried upgrading it through Visual studio, but kept getting Dim errors because the newer versions didn't support what they were doing. So I copied the code into excel 2007 on Vista and it mostly works. It errors out on the last sub when it tries to Print because of a error 52, bad filename. I had it working, but for some reason it stopped working and I'm back to where I started.
Here's what I tried to do:

run time error 52 bad filename or number problem
error @: Print #2, String$(NoTestItems * 3 + InpVar1Size + 19, 45)
And all following Prints

Added:
Public TrailFildef$

created a trailer file Trailfildef$
TrailerFile$ = "C:\Users\Mike\Desktop\CattraxStuff\Trailer.txt"

made it print to transfer file added next line to trailerfile() sub
Print #2, "Trailer File: "; TrailFildef$

This seemed to work for the first few times I ran it and then it stopped and gave me an error on the last bit above.

I'm not sure what to do at this point. Would anyone have any pointers?

Code below and thank you for looking,
Mike

Code:

'Diags.bas
'CAT diagnostic module
'copyright 1999 PCallahan
'Ver 2.0


'INPUT file info:
'1st rec contains NoAnsKeys
'   OR NoStuRecs & NoTestItems & NoAnsKeys & InpVar1Size
'2nd and 3rd? recs contain answer keys - datum separated with one space or no spaces
'Subsequent recs contain data


DefInt A-Y
'default file names
Public SUMFILDEF$
Public OUTFILDEF$
Public STUOUTCOMES$
Public INPFILDEF$
Public TrailFildef$
'Data Header Record
Public NoStuRecs
Public NoTestItems
Public NoAnsKeys
Public InpIdSize
Public InpNameSize
Public InpVar1Size
Public Locat                        'Item spacing
'Operational variables
Public NoAnsKeysRange
Public ItPrg                        'Item purge switch - . found in answer key
Public DoIA                         'Item Analysis run query
Public IAGroupSize                  '.27 High/low group sizes
Public TotOpts                      'No of possible responses to item
Public DoIndTests                   'Create a summary file of id, mci, and score
Public TestType As Integer          'Type for examinee (0) Z, (1) PR
Public Recrd()                      'NoStuRecs +1 is item no, +2 is item total, +3 is item MCI,
                                    '+4 is discrimination, +5 is biserial correlation
                                    'NoTestItems +1 is stu no, +2 is stu total, +3 is stu MCI
Public DRecrd$()                    'Examinee input record
Public Var1$()                      'Examinee id/name var
Public DimSize
Public SUM1() As Long               'MCI sum
Public SUM2() As Long               'MCI sum
Public SUM3() As Long               'MCI sum
Public SUM4() As Long               'MCI sum
Public Ans$()                       'Store answer key in 1 and distractors in 2
Public PerRank()                    'Freq Distribution 1-score, 2-freq, 3-%rank
'report variables
Public PerRow                       'percentile rank counter
Public EdLongRow As Long
Public EdLongCol
Public EdRows
Public EdCols
Public Pass
Public Title$
Public DoNames
Public Row
Public ZM
Public ZSD
Public ZKR20
Public SumStuMCI As Long
Public SumItMCI
Public ZPM
Public ZPSD
Public ZPSum
Public ZPSumSq
'sorting vars
Public Sorted
Public Col
Public RowCK
Public ColCK
'Item Analysis Info
Public OptioNo(4, 10) As Integer    'IA counts store (1-High, 2-Middle, 3-Low, 4-Total)
Public OptionStr(10) As String
Public KeyCnt                       'no of ans keys loop increment
Global FileMenuOption



'Initiate processing
Sub ProcessTest(TestType, DoIA, DoIndTests)
    Call InitializeVars
    Call ExtractFileParam      '1st rec - data parameters
    Call DimArrays
    Call ReadAnsKey              '2nd 3rd? recs - answer keys
    Call ReadExaminee          'Load & correct examinee records
    If ItPrg = 1 Then
        Call PurgeOmitItems
    End If
    Call TotalExaminee         'Total row
    Call TotalItem             'Total column'
    If DoIndTests = 1 Then
        Call ExamineeOutcomeRec 'Create outcome file for students
    End If
    Call RowSort
    Call ColSort
    If TestType = 1 Then
        Call PercentileRank
    End If
    Call CalcRowMCI
    Call CalcColMCI
    Call CalcIAItems                       'Summary IA calcs
    Call CalcBiserialCorr                  'Biserial correlation
    Open OUTFILDEF$ For Output As #2
    Call RecordResults                     'File MCI results
    Call CreateSummaryFile                 'Create summary file for spreadsheet/ledger
    If DoIA = 1 Then
        Call CalcIAProblems   'Detailed IA for item options
    End If
    
    'Subsequent Ans Key Analysis Follows
    If NoAnsKeys = 1 And DoIA = 1 Then
        NoAnsKeysRange = 2 'set for 2nd key next best build
    Else
        NoAnsKeysRange = NoAnsKeys 'set for multiple answer keys
    End If
    For KeyCnt = 2 To NoAnsKeysRange
        Call DistReadExaminee
        If ItPrg = 1 Then
            Call DistPurgeOmitItems
        End If
        Call TotalExaminee
        Call TotalItem
        Call RowSort
        Call ColSort
        If TestType = 1 Then
            Call PercentileRank
        End If
        Call CalcRowMCI
        Call CalcColMCI
        Call RecordResults
    Next KeyCnt
    Close #2
End Sub

'for debugging purposes
Sub playback()
    For k = 1 To 2
        For AnsCol = 1 To NoTestItems
            Debug.Print k; Recrd(NoStuRecs + 1, AnsCol); Ans$(k, AnsCol)
        Next AnsCol
    Next k
End Sub


Sub InitializeVars()
    'Operational Parameters File
    'c:\catfiles\WebInput.txt is the test input data file
    SUMFILDEF$ = "C:\Users\Mike\Desktop\CattraxStuff\SummaryOut.txt"
    OUTFILDEF$ = "C:\Users\Mike\Desktop\CattraxStuff\OutcomesOut.txt"
    STUOUTCOMES$ = "C:\Users\Mike\Desktop\CattraxStuff\StudentOut.txt"
    INPFILDEF$ = "C:\Users\Mike\Desktop\CattraxStuff\Input.txt"
    'created a trailer file
    TrailerFile$ = "C:\Users\Mike\Desktop\CattraxStuff\Trailer.txt"
    'Data Header Record
    NoStuRecs = 0
    NoTestItems = 0
    NoAnsKeys = 0                         'Number of correction Levels
    InpVar1Size = 0                       'Byte size of examinee info
    'Operational variables
    ItPrg = 0                             'Item purge switch - . found in answer key
    IAGroupSize = 0                       '.27 High/low group sizes
    TotOpts = 0                           'No of possible responses to item
    'set working vars
    'vars sent by form
    'DoIA = 1            'item analysis 1 or 0
    'DoIndTests = 1      'outcome summary scores 1 or 0 -- Create a summary file of id, mci, and score
    'TestType = 0        'Percentile(1)/Zscores(0)
    DoNames = 1         'show names
    EdLongRow = 0
    EdLongCol = 8
    EdRows = 0
    EdCols = 0
    Pass = 0
End Sub

Sub ExtractFileParam()
    '1st rec - StudentCnt, ItemCnt, NoAnsKeys, InpIdSize, InpNameSize + 1
    Open INPFILDEF$ For Input As #1
    Input #1, NoStuRecs, NoTestItems, NoAnsKeys, InpIdSize, InpNameSize
    InpVar1Size = InpIdSize + InpNameSize + 1
    'determine spacing (Locat) between datum for reading input data
    Input #1, All$
    If Mid$(All$, 1, 1) = " " Then
        MsgBox ("WARNING: Data File Appears Mis-Aligned")
        Stop
    End If
    If Mid$(LTrim$(All$), 2, 1) <> " " Then
        Locat = 1
    End If
    If Mid$(LTrim$(All$), 2, 1) = " " Then
        Locat = 2
    End If
    Close #1
End Sub

Sub DimArrays()
    'Examinee results
    ReDim Recrd(NoStuRecs + 5, NoTestItems + 3)
        'NoStuRecs +1 is item no, +2 is item total, +3 is item MCI,
        '+4 is discrimination, +5 is biserial correlation
        'NoTestItems +1 is stu no, +2 is stu total, +3 is stu MCI
    ReDim DRecrd$(NoStuRecs + 5, NoTestItems + 3)     'Examinee input record
    ReDim Var1$(NoStuRecs)                            'Examinee id/name var
    'Item Analysis Info
    Dim OptioNo(4, 10) As Integer 'IA counts store (1-High, 2-Middle, 3-Low, 4-Total)
    Dim OptionStr(10) As String
    'IA options key store
    If NoStuRecs > NoTestItems Then
        DimSize = NoStuRecs + 5
    Else
        DimSize = NoTestItems + 3
    End If
    ReDim SUM1(DimSize)
    ReDim SUM2(DimSize)
    ReDim SUM3(DimSize)
    ReDim SUM4(DimSize)
    ReDim Ans$(NoAnsKeys + 1, NoTestItems + 3)  'answer keys for multiple provided keys
    ReDim PerRank(NoStuRecs, 3)             'Freq Distribution 1-score, 2-freq, 3-%rank
End Sub


Sub ReadAnsKey()
    'Reposition file for Answer Key data entry
    Close #1
    Open INPFILDEF$ For Input As #1
    Input #1, All$
    'Load answer key and distractor key
    For Level = 1 To NoAnsKeys
        Input #1, All$
        Col = 0
        For Count = 1 To NoTestItems * Locat Step Locat
            Col = Col + 1
            Ans$(Level, Col) = Mid$(All$, Count, 1)
            'Purge item flag
            If Mid$(All$, Count, 1) = "." Then
                ItPrg = 1
            End If
        Next Count
    Next Level
End Sub


Sub ReadExaminee()
    'Read and correct examinee records
    Title$ = "1st Answer Key Results"
    Erase OptionStr
    TotOpts = 0
    For Row = 1 To NoStuRecs
        Col = 0
        Line Input #1, All$
        For Count = 1 To NoTestItems * Locat Step Locat    'Locat determines space between item response data
            Col = Col + 1
            'Correct and load into dichotomous array
            If Mid$(All$, Count, 1) = Ans$(1, Col) Then
                Recrd(Row, Col) = 1
            End If
            'Load raw responses into array
            DRecrd$(Row, Col) = Mid$(All$, Count, 1)
            'Load item nos
            Recrd(NoStuRecs + 1, Col) = Col         'Item number
            'scan for option response - load all possible option responses
            Found = 0
            For OptCnt = 1 To TotOpts
                If Mid$(All$, Count, 1) = OptionStr(OptCnt) Then
                    Found = 1
                    OptCnt = TotOpts
                End If
            Next OptCnt
            If Found = 0 Then
                TotOpts = TotOpts + 1
                OptionStr(TotOpts) = Mid$(All$, Count, 1)
            End If
        Next Count
        'Load examinee demographic info
        Var1$(Row) = Mid$(All$, (NoTestItems * Locat) + (3 - Locat), InpVar1Size)
    Next Row
    Close #1
End Sub


Sub PurgeOmitItems()
    'Read and purge omitted items
    For AnsCol = 1 To NoTestItems
        Row = 0
        If Ans$(1, AnsCol) = "." Then
            'Shift entire array to the left one item
            For Shift = AnsCol To NoTestItems + 2
                For Row = 1 To NoStuRecs + 5
                    Recrd(Row, Shift) = Recrd(Row, Shift + 1)
                    DRecrd$(Row, Shift) = DRecrd$(Row, Shift + 1)
                Next Row
                For KeyCntSub = 1 To NoAnsKeys
                    Ans$(KeyCntSub, Shift) = Ans$(KeyCntSub, Shift + 1)
                Next KeyCntSub
            Next Shift
            'reset counters for omit and shift back 1 counter
            NoTestItems = NoTestItems - 1
            AnsCol = AnsCol - 1
        End If
    Next AnsCol
End Sub

   
Sub DistReadExaminee()
    'Read, correct examinee records, and total records
    Title$ = "Multiple Answer Key Results"
    'Second pass reload keys
    Close #1
    Open INPFILDEF$ For Input As #1
    Input #1, All$
    Call ReadAnsKey
    'read and correct records
    For Row = 1 To NoStuRecs
        Col = 0
        Input #1, All$
        For Count = 1 To NoTestItems * Locat Step Locat
            Col = Col + 1
            'Correct and load into array Ans$1 is 1st answer key, Ans$2 is 2nd key etc.
             Recrd(Row, Col) = 0
            For KeyCntSub = 1 To KeyCnt
                If Mid$(All$, Count, 1) = Ans$(KeyCntSub, Col) Then
                    Recrd(Row, Col) = 1
                End If
            Next KeyCntSub
            'Load raw responses into array
            DRecrd$(Row, Col) = Mid$(All$, Count, 1)
            'Load item nos
            Recrd(NoStuRecs + 1, Col) = Col         'Item number
        Next Count
        'Load examinee demographic info - spacing adjusted for input format
        Var1$(Row) = Mid$(All$, (NoTestItems * Locat) + (3 - Locat), InpVar1Size)
    Next Row
    Close #1
End Sub

Sub DistPurgeOmitItems()
    'Read and purge omitted items
    For AnsCol = 1 To NoTestItems
        Row = 0
        If Ans$(1, AnsCol) = "." Then
            'Shift entire array to the left one item
            For Shift = AnsCol To NoTestItems + 2
                For Row = 1 To NoStuRecs + 5
                    Recrd(Row, Shift) = Recrd(Row, Shift + 1)
                    DRecrd$(Row, Shift) = DRecrd$(Row, Shift + 1)
                Next Row
                For KeyCntSub = 1 To KeyCnt
                    Ans$(KeyCntSub, Shift) = Ans$(KeyCntSub, Shift + 1)
                Next KeyCntSub
            Next Shift
            'reset counters for omit and shift back 1 counter
            NoTestItems = NoTestItems - 1
            AnsCol = AnsCol - 1
        End If
    Next AnsCol
End Sub
Sub TotalExaminee()
    Sum# = 0: SumSq# = 0
    For Row = 1 To NoStuRecs
        Rowsum = 0
        For Col = 1 To NoTestItems
            Rowsum = Rowsum + Recrd(Row, Col)
        Next Col
        Recrd(Row, NoTestItems + 1) = Row       'Id locator number for student
        Recrd(Row, NoTestItems + 2) = Rowsum    'Total correct for student
        Sum# = Sum# + Rowsum
        SumSq# = SumSq# + (Rowsum * Rowsum)
    Next Row
    IAGroupSize = CInt(0.27 * NoStuRecs) 'IA calc for high & low group size
    'Standard deviation SD
    ZSD = Sqr((SumSq# - ((Sum# * Sum#) / NoStuRecs)) / NoStuRecs)
    ZM = Sum# / NoStuRecs
End Sub


Sub ExamineeOutcomeRec()
    'Create an examinee outcome record
    Open STUOUTCOMES$ For Output As #4
    For Row = 1 To NoStuRecs
        'LOCATE 18, 1: Print String$(79, Chr$(32))
        'LOCATE 18, 1: Print Chr$(179); "   Creating Examinee Outcome Rec:"; Row;: LOCATE 18, 78: Print Chr$(179)
        Print #4, String$(75, 45)
        Print #4,: Print #4, "       Id: "; Var1$(Row);
        ORPass = 1: Begin = 1
        If NoTestItems < 23 Then
            Finish = NoTestItems
        Else
            Finish = 22
        End If
        Do While ORPass = 1
            Print #4,: Print #4,: Print #4, "     Item:";
            For Col = Begin To Finish
                Print #4, Format(Col, "@@@");
            Next Col
            Print #4,: Print #4, "   Answer:";
            For Col = Begin To Finish
                Print #4, Format(Ans$(1, Col), "  <");
            Next Col
            Print #4,: Print #4, " Response:";
            For Col = Begin To Finish
                Print #4, Format(DRecrd$(Row, Col), "  <");
            Next Col
            Print #4,: Print #4, "  Results:";
            For Col = Begin To Finish
                If Recrd(Row, Col) = 0 Then
                    Print #4, "  X";
                Else
                    Print #4, "   ";
                End If
                'Print #4, Format(Recrd(Row, Col), "  0");
            Next Col
            If Finish = NoTestItems Then
                ORPass = 2
            Else
                Begin = Finish + 1
                If NoTestItems - Finish < 23 Then
                    Finish = NoTestItems
                Else
                    Finish = Finish + 22
                End If
            End If
            ExOuRecLineCntr# = ExOuRecLineCntr# + 5
        Loop
        Print #4,: Print #4,: Print #4, "   Number Correct:"; Recrd(Row, NoTestItems + 2);
        Print #4, "    Percent Correct:";
        PrcntCrrt = (Recrd(Row, NoTestItems + 2) / NoTestItems) * 100
        Print #4, Format(PrcntCrrt, " @@@")
        Print #4, "Class Ave Correct:";
        Print #4, Format(ZM, "###.#");
        Print #4, "   Class Standard Deviation:";
        Print #4, Format(ZSD, "##.#")
        Print #4,
        ExOuRecLineCntr# = ExOuRecLineCntr# + 8
    Next Row
    Close #4
End Sub


Sub TotalItem()
    ZsumPQ = 0
    For Col = 1 To NoTestItems
        Colsum = 0
        For Row = 1 To NoStuRecs
            Colsum = Colsum + Recrd(Row, Col)
        Next Row
        Recrd(NoStuRecs + 2, Col) = Colsum      'Total correct
        ZP = Colsum / NoStuRecs                 'Proportion correct
        ZQ = (NoStuRecs - Colsum) / NoStuRecs   'Proportion incorrect
        ZsumPQ = ZsumPQ + (ZP * ZQ)
        
        'Debug.Print NoTestItems; Col; ZP; ZQ; ZsumPQ
    Next Col
    If ZsumPQ = 0 Or NoTestItems = 0 Then
        ZKR20 = 0                               'Aborting calculation
    Else
        'ZKR20 = ((NoTestItems / (NoTestItems - 1)) * (1 - (ZSumPQ / (ZSD * ZSD))))
        'kitty
        
        ZKR20 = ((NoTestItems / (NoTestItems - 1)) * (((ZSD * ZSD) - ZsumPQ) / (ZSD * ZSD)))
    End If
End Sub


Sub RowSort()
   Gap = NoStuRecs \ 2
   While Gap >= 1
       Sorted = 0
       While Sorted = 0
           Sorted = 1
           MaxRow = NoStuRecs - Gap
           For Row = 1 To MaxRow
               RowCK = Row + Gap
               If Recrd(Row, NoTestItems + 2) < Recrd(RowCK, NoTestItems + 2) Then
                    Call SwapRow
               End If
           Next Row
       Wend
       Gap = Gap \ 2
   Wend
End Sub


Sub SwapRow()
    Dim swap As String
    For Col = 1 To NoTestItems + 3
        'SWAP Recrd(Row, Col), Recrd(ROWCK, Col)
        swap = Recrd(Row, Col)
        Recrd(Row, Col) = Recrd(RowCK, Col)
        Recrd(RowCK, Col) = swap
        'SWAP DRecrd$(Row, Col), DRecrd$(ROWCK, Col)
        swap = DRecrd$(Row, Col)
        DRecrd$(Row, Col) = DRecrd$(RowCK, Col)
        DRecrd$(RowCK, Col) = swap
    Next Col
    Sorted = 0
End Sub


Sub ColSort()
   Gap = NoTestItems \ 2
   While Gap >= 1
       Sorted = 0
       While Sorted = 0
           Sorted = 1
           MaxCol = NoTestItems - Gap
           For Col = 1 To MaxCol
               ColCK = Col + Gap
               If Recrd(NoStuRecs + 2, Col) < Recrd(NoStuRecs + 2, ColCK) Then
                    Call SwapCol
                End If
         Next Col
       Wend
       Gap = Gap \ 2
   Wend
End Sub


Sub SwapCol()
    Dim swap As String
    For Row = 1 To NoStuRecs + 3
       'SWAP Recrd(Row, Col), Recrd(Row, COLCK)
       swap = Recrd(Row, Col)
       Recrd(Row, Col) = Recrd(Row, ColCK)
       Recrd(Row, ColCK) = swap
       'SWAP DRecrd$(Row, Col), DRecrd$(Row, COLCK)
       swap = DRecrd$(Row, Col)
       DRecrd$(Row, Col) = DRecrd$(Row, ColCK)
       DRecrd$(Row, ColCK) = swap
   Next Row
   
    For KeyCntSub = 1 To NoAnsKeys + 1
        swap = Ans$(KeyCntSub, Col)
        Ans$(KeyCntSub, Col) = Ans$(KeyCntSub, ColCK)
        Ans$(KeyCntSub, ColCK) = swap
    Next KeyCntSub
   
   Sorted = 0
End Sub


Sub PercentileRank()
    'PerRank(x,1) score, PerRank(x,2) frequency for score, PerRank(x,3) is PR
    LastRec = 0: PerRow = 0
    For Row = NoStuRecs To 1 Step -1
        'establish freq distribution
        If Recrd(Row, NoTestItems + 2) > LastRec Then
            PerRow = PerRow + 1
            PerRank(PerRow, 1) = Recrd(Row, NoTestItems + 2)
            PerRank(PerRow, 2) = 1
            LastRec = Recrd(Row, NoTestItems + 2)
        ElseIf Recrd(Row, NoTestItems + 2) = LastRec Then
            PerRank(PerRow, 2) = PerRank(PerRow, 2) + 1
        End If
    Next Row
    'mid-interval percentile rank = CRFBelow ref score + .5(RF)
    RunFreq = 0
    For Row = 1 To PerRow
        ZRF = PerRank(Row, 2) / NoStuRecs
        ZCRFBelow = RunFreq / NoStuRecs
        PerRank(Row, 3) = (ZCRFBelow + (0.5 * ZRF)) * 100
        RunFreq = PerRank(Row, 2) + RunFreq
        ZCRFBelow = RunFreq / NoStuRecs
    Next Row
End Sub


Sub CalcRowMCI()
    SumStuMCI = 0
    For Row = 1 To NoStuRecs
        SUM1(Row) = 0: SUM2(Row) = 0: SUM3(Row) = 0: SUM4(Row) = 0
        For Col = 1 To Recrd(Row, NoTestItems + 2)
            SUM1(Row) = SUM1(Row) + (1 - Recrd(Row, Col)) * Recrd(NoStuRecs + 2, Col)
            SUM3(Row) = SUM3(Row) + Recrd(NoStuRecs + 2, Col)
        Next Col
        For Col = Recrd(Row, NoTestItems + 2) + 1 To NoTestItems
            SUM2(Row) = SUM2(Row) + Recrd(Row, Col) * Recrd(NoStuRecs + 2, Col)
        Next Col
        For Col = NoTestItems + 1 - Recrd(Row, NoTestItems + 2) To NoTestItems
            SUM4(Row) = SUM4(Row) + Recrd(NoStuRecs + 2, Col)
        Next Col
        If SUM3(Row) - SUM4(Row) <> 0 Then Recrd(Row, NoTestItems + 3) = (SUM1(Row) - SUM2(Row)) / (SUM3(Row) - SUM4(Row)) * 100 Else Recrd(Row, NoTestItems + 3) = 0
        'running total for student MCI
        SumStuMCI = SumStuMCI + Recrd(Row, NoTestItems + 3)
    Next Row
End Sub


Sub CalcColMCI()
    SumItMCI = 0
    For Col = 1 To NoTestItems
        SUM1(Col) = 0: SUM2(Col) = 0: SUM3(Col) = 0: SUM4(Col) = 0
        For Row = 1 To Recrd(NoStuRecs + 2, Col)
            SUM1(Col) = SUM1(Col) + (1 - Recrd(Row, Col)) * Recrd(Row, NoTestItems + 2)
            SUM3(Col) = SUM3(Col) + Recrd(Row, NoTestItems + 2)
        Next Row
        For Row = Recrd(NoStuRecs + 2, Col) + 1 To NoStuRecs
            SUM2(Col) = SUM2(Col) + Recrd(Row, Col) * Recrd(Row, NoTestItems + 2)
        Next Row
        For Row = NoStuRecs + 1 - Recrd(NoStuRecs + 2, Col) To NoStuRecs
            SUM4(Col) = SUM4(Col) + Recrd(Row, NoTestItems + 2)
        Next Row
        If SUM3(Col) - SUM4(Col) <> 0 Then Recrd(NoStuRecs + 3, Col) = (SUM1(Col) - SUM2(Col)) / (SUM3(Col) - SUM4(Col)) * 100 Else Recrd(NoStuRecs + 3, Col) = 0
        'running total for item MCI
        SumItMCI = SumItMCI + Recrd(NoStuRecs + 3, Col)
    Next Col
End Sub


Sub CalcIAItems()
   For Col = 1 To NoTestItems
       'Calc High Group
       SUMHigh = 0
       For Row = 1 To IAGroupSize
           SUMHigh = SUMHigh + Recrd(Row, Col)
       Next Row
       HighCorrect = (SUMHigh / IAGroupSize) * 100
       SUMLow = 0
       'Calc Low Group
       For Row = ((NoStuRecs - IAGroupSize) + 1) To NoStuRecs
           SUMLow = SUMLow + Recrd(Row, Col)
       Next Row
       LowCorrect = (SUMLow / IAGroupSize) * 100
       'Item Discrimination
       Recrd(NoStuRecs + 4, Col) = HighCorrect - LowCorrect
       'Item difficulty calc: Recrd(NoStuRecs+2)/NoStuRecs
   Next Col
End Sub


Sub CalcIAProblems()
    'Info read in param record - note: omit is an added option
    'Bubble sort options for easy visual comparison
    Call SortIAProbOptions
    'Distribution of responses for all items
    For Col = 1 To NoTestItems
        'Calc High Group
        For Row = 1 To IAGroupSize
            For Cnt = 1 To TotOpts
                If DRecrd$(Row, Col) = OptionStr(Cnt) Then
                    OptioNo(1, Cnt) = OptioNo(1, Cnt) + 1
                End If
            Next Cnt
        Next Row
        'Calc Middle Group
        Limit = 0
        For Row = IAGroupSize + 1 To NoStuRecs - IAGroupSize
            For Cnt = 1 To TotOpts
                If DRecrd$(Row, Col) = OptionStr(Cnt) Then
                    OptioNo(2, Cnt) = OptioNo(2, Cnt) + 1
                End If
            Next Cnt
        Next Row
        'Calc Low Group
        For Row = ((NoStuRecs - IAGroupSize) + 1) To NoStuRecs
            For Cnt = 1 To TotOpts
                If DRecrd$(Row, Col) = OptionStr(Cnt) Then
                    OptioNo(3, Cnt) = OptioNo(3, Cnt) + 1
                End If
            Next Cnt
        Next Row
        'Record results
        Call RecordIAProbResults
        'Calculate distractor key if only 1 answer key supplied
        If NoAnsKeys = 1 Then Call CalcIAProbDistractKey
        'Clear array of totals for next item
        Erase OptioNo
   Next Col
   Print #2, "* indicates keyed response"
   Print #2, ". indicates omitted response"
   Print #2,: Print #2,: Print #2,
End Sub


Sub SortIAProbOptions()
    Limit = TotOpts
    Dim switch
    Dim swap As String
    Do
        switch = 0
        For Col = 1 To (Limit - 1)
            If OptionStr(Col) > OptionStr(Col + 1) Then
                'SWAP OptionStr(Col) = OptionStr(Col + 1)
                swap = OptionStr(Col)
                OptionStr(Col) = OptionStr(Col + 1)
                OptionStr(Col + 1) = swap
                switch = Col
            End If
        Next Col
        'Sort on next pass only to where the last switch was made:
        Limit = switch
    Loop While switch
End Sub


Sub RecordIAProbResults()
    Print #2, "Item:"; Recrd(NoStuRecs + 1, Col)
    Print #2, "Diff: ."; CInt((Recrd(NoStuRecs + 2, Col) / NoStuRecs) * 100);
    Print #2, "  Disc: ."; Recrd(NoStuRecs + 4, Col);
    Print #2, "  Biserial r: ."; Recrd(NoStuRecs + 5, Col)
    Print #2, "Group  Grp N     ";
    'Item option titling
    For Cnt = 1 To TotOpts
        If Ans$(1, Col) = OptionStr(Cnt) Then
            Print #2, "  *";
            Print #2, Format(OptionStr(Cnt), "00 ");
        Else
            Print #2, Format(OptionStr(Cnt), "   00 ");
        End If
    Next Cnt
    Print #2,: Print #2, String$(TotOpts * 6 + 24, 45)
    
    For Grp = 1 To 3
        If Grp = 1 Then
            'Print no of students in subgroups
            Print #2, "High  ";
            If IAGroupSize > 99 Then
                Print #2, Format(IAGroupSize, "  ##0  ");
            ElseIf IAGroupSize > 9 Then
                Print #2, Format(IAGroupSize, "   #0  ");
            Else
                Print #2, Format(IAGroupSize, "    0  ");
            End If
            'Print #2, Format(IAGroupSize, "  000  ");
        ElseIf Grp = 2 Then
            Print #2, "Middle";
            Middle = (NoStuRecs - (2 * IAGroupSize))
            If IAGroupSize > 99 Then
                Print #2, Format(Middle, "  ##0  ");
            ElseIf IAGroupSize > 9 Then
                Print #2, Format(Middle, "   #0  ");
            Else
                Print #2, Format(Middle, "    0  ");
            End If
            'Print #2, Format(Middle, "  000  ");
        Else
            Print #2, "Low   ";
            If IAGroupSize > 99 Then
                Print #2, Format(IAGroupSize, "  ##0  ");
            ElseIf IAGroupSize > 9 Then
                Print #2, Format(IAGroupSize, "   #0  ");
            Else
                Print #2, Format(IAGroupSize, "    0  ");
            End If
        End If
        'Print body of table--no of students by item options
        For Optn = 1 To TotOpts
            If OptioNo(Grp, Optn) > 99 Then
                Print #2, Format(OptioNo(Grp, Optn), " ##0  ");
            ElseIf OptioNo(Grp, Optn) > 9 Then
                Print #2, Format(OptioNo(Grp, Optn), "  #0  ");
            Else
                Print #2, Format(OptioNo(Grp, Optn), "   0  ");
            End If
            'Print #2, Format(OptioNo(Grp, Optn), " 000  ");
            OptioNo(4, Optn) = OptioNo(4, Optn) + OptioNo(Grp, Optn)
        Next Optn
        Print #2,
    Next Grp
    'Print total students in group
    Print #2, "Total ";
    If NoStuRecs > 99 Then
        Print #2, Format(NoStuRecs, "  ###  ");
    ElseIf NoStuRecs > 9 Then
        Print #2, Format(NoStuRecs, "   ##  ");
    Else
        Print #2, Format(NoStuRecs, "    0  ");
    End If
    'Print #2, Format(NoStuRecs, "  000  ");
    'Print totals for body of table
    For Optn = 1 To TotOpts
        If OptioNo(4, Optn) > 99 Then
            Print #2, Format(OptioNo(4, Optn), " ###  ");
        ElseIf OptioNo(4, Optn) > 9 Then
            Print #2, Format(OptioNo(4, Optn), "  ##  ");
        Else
            Print #2, Format(OptioNo(4, Optn), "   0  ");
        End If
        'Print #2, USING; " ###  "; OptioNo(4, Optn);
        'Print #2, Format(OptioNo(4, Optn), " 000  ");
    Next Optn
    Print #2,: Print #2,
    'count no lines Printed
    EdLongRow = EdLongRow + 9
End Sub


Sub CalcIAProbDistractKey()
    'called for each item
    'Calculate distractors
     DistSum = 0: HighSum = 0
     For Optn = 1 To TotOpts 'cycle through all possible responses
        'OptionStr -- all possible option responses
        If Ans$(1, Col) <> OptionStr(Optn) And OptionStr(Optn) <> "." Then
            'OptioNo -- IA counts store (1-High, 2-Middle, 3-Low, 4-Total)
            If OptioNo(4, Optn) > DistSum Then
                DistSum = OptioNo(4, Optn)
                HighSum = OptioNo(1, Optn)
                Position = Recrd(NoStuRecs + 1, Col)   'Sequentially orient Ans Key
                Ans$(2, Position) = OptionStr(Optn)
            ElseIf OptioNo(4, Optn) = DistSum Then
                'tie results check high group
                If OptioNo(1, Optn) > HighSum Then
                    DistSum = OptioNo(4, Optn)
                    HighSum = OptioNo(1, Optn)
                    Position = Recrd(NoStuRecs + 1, Col)   'Sequentially orient Ans Key
                    Ans$(2, Position) = OptionStr(Optn)
                End If
            End If
        End If
    Next Optn
End Sub


Sub CalcBiserialCorr()
    For Col = 1 To NoTestItems
        ZSumXY = 0: ZSumXSq = 0: ZSumYSq = 0
        For Row = 1 To NoStuRecs
            ZX = ZM - Recrd(Row, NoTestItems + 2)
            ZY = (Recrd(NoStuRecs + 2, Col) / NoStuRecs) - Recrd(Row, Col)
            ZXSq = ZX * ZX
            ZYSq = ZY * ZY
            ZSumXSq = ZSumXSq + ZXSq
            ZSumYSq = ZSumYSq + ZYSq
            ZSumXY = ZSumXY + (ZX * ZY)
        Next Row
        ZSDX = Sqr(ZSumXSq / NoStuRecs)
        ZSDY = Sqr(ZSumYSq / NoStuRecs)
        If ZSumXY = 0 Or (NoStuRecs * ZSDX * ZSDY) = 0 Then
            Recrd(NoStuRecs + 5, Col) = 0
        Else
            Recrd(NoStuRecs + 5, Col) = (ZSumXY / (NoStuRecs * ZSDX * ZSDY)) * 100
        End If
    Next Col
End Sub


Sub RecordResults()
   ZPSum = 0: ZPSumSq = 0: FileCtr = 0
   If OUTFILDEF$ <> "" Then
        Call HeadingFile
        For Row = 1 To NoStuRecs
            FileCtr = FileCtr + 1
            If FileCtr > 52 Then
                Call HeadingFile
                FileCtr = 0
            End If
            Call RecordFile
        Next Row
        Call TrailerFile
   End If
End Sub


Sub CreateSummaryFile()
    'write id, mci, % correct, and 1-Z score
    Open SUMFILDEF$ For Output As #3
    Write #3, NoStuRecs, NoTestItems, NoAnsKeys, InpIdSize, InpNameSize
    For Row = 1 To NoStuRecs
        If ZSD <> 0 Then
            Write #3, Var1$(Recrd(Row, NoTestItems + 1)), Recrd(Row, NoTestItems + 3), ((Recrd(Row, NoTestItems + 2) / NoTestItems) * 100), (Recrd(Row, NoTestItems + 2) - ZM) / ZSD 'Z Score
        End If
    Next Row
    Close #3
End Sub


Sub HeadingFile()
    Print #2, "Input File: "; INPFILDEF$
    Print #2, ""; Title$
    Print #2, String$(NoTestItems * 3 + InpVar1Size + 19, 45)
    If TestType = 0 Then
        If DoNames = 1 Then
            Print #2, Spc(InpVar1Size + 1); "MCI Tot Raw  LinZ ";
        Else
            Print #2, Spc(InpIdSize + 1); "MCI Tot Raw  LinZ ";
        End If
    Else
        If DoNames = 1 Then
            Print #2, Spc(InpVar1Size + 1); "MCI Tot Raw   PR  ";
        Else
            Print #2, Spc(InpIdSize + 1); "MCI Tot Raw   PR  ";
        End If
    End If
    For Col = 1 To NoTestItems
        Print #2, Format(Recrd(NoStuRecs + 1, Col), "00 ");
    Next Col
    Print #2,: Print #2, String$(NoTestItems * 3 + InpVar1Size + 19, 45)
    FileCtr = 3
    'count no lines Printed
    EdLongRow = EdLongRow + 6
End Sub


Sub RecordFile()
    'individual id/name record - parse for DoNames
    If DoNames = 1 Then
        Print #2, Var1$(Recrd(Row, NoTestItems + 1));
        Print #2, Space$(InpVar1Size - Len(Var1$(Recrd(Row, NoTestItems + 1)))); " ";
    Else
        'nonames parse id/name
        Print #2, Left$(Var1$(Recrd(Row, NoTestItems + 1)), InpIdSize); " ";
        Print #2, Space$(InpVar1Size - Len(Var1$(Recrd(Row, NoTestItems + 1)))); " ";
    End If
    Print #2, Format(Recrd(Row, NoTestItems + 3), "000 ");    'MCI
    Print #2, Format(Recrd(Row, NoTestItems + 2), "000 ");   'Total
    PercentCrrt = (Recrd(Row, NoTestItems + 2) / NoTestItems) * 100
    Print #2, Format(PercentCrrt, "000 ");  '% Crrt
    If ZSD = 0 Then
        Print #2, "       ";
    Else
        '1-Z Score
        If TestType = 0 Then
            zscore = (Recrd(Row, NoTestItems + 2) - ZM) / ZSD
            If zscore < 0 Then
                Print #2, Format(zscore, "0.00  "); 'Z Score
            Else
                Print #2, Format(zscore, " 0.00  "); 'Z Score
            End If
        Else
            'scan percentile rank array for tot crrt match and Print pr
            For PRow = 1 To PerRow
                If Recrd(Row, NoTestItems + 2) = PerRank(PRow, 1) Then
                    Print #2, Format(PerRank(PRow, 3), " 000   "); 'percentile rank
                End If
            Next PRow
        End If
    End If
    'calc % correct for M and SD
    ZPSum = ZPSum + ((Recrd(Row, NoTestItems + 2) / NoTestItems) * 100)
    ZPSumSq = ZPSumSq + ((Recrd(Row, NoTestItems + 2) / NoTestItems) * 100) * ((Recrd(Row, NoTestItems + 2) / NoTestItems) * 100)
    For Col = 1 To NoTestItems
        'check for omits and display as period
        If DRecrd$(Row, Col) = "." Then
            Print #2, ".  ";
            'Print #2, Format(DRecrd$(Row, Col), ">  ");
        Else
            Print #2, Format(Recrd(Row, Col), "0  ");
        End If
    Next Col
    Print #2,
    'count no lines Printed
    EdLongRow = EdLongRow + 1
End Sub


Sub TrailerFile()
    Print #2, String$(NoTestItems * 3 + InpVar1Size + 19, 45)
    If DoNames = 1 Then
        'include name with id
        InpVarSize = InpVar1Size
    Else
        'id only
        InpVarSize = InpIdSize
    End If
    Print #2, Spc(InpVarSize + 7); "Item Total:";
    For Col = 1 To NoTestItems  'item yotal
        Print #2, Format(Recrd(NoStuRecs + 2, Col), " 00");
    Next Col
    Print #2,: Print #2, Spc(InpVarSize + 4); "Difficulty% p:";
    For Col = 1 To NoTestItems  'difficulty
        Prrcnt = (Recrd(NoStuRecs + 2, Col) / NoStuRecs) * 100
        If Prrcnt = 100 Then
            Print #2, "100";
        Else
            Print #2, Format(Prrcnt, " 00");
        End If
    Next Col
    Print #2,: Print #2, Spc(InpVarSize + 9); "Item MCI:";
    For Col = 1 To NoTestItems  'item mci
        If Recrd(NoStuRecs + 3, Col) = 100 Then
            Print #2, "100";
        Else
            Print #2, Format(Recrd(NoStuRecs + 3, Col), " 00");
        End If
    Next Col
    
    'IA Information - answer key for distractor output or item analysis on 1st pass
    If Pass = 2 Then
        Print #2,: Print #2,: Print #2, Spc(InpVarSize + 3); "Keyed Response:";
        For Col = 1 To NoTestItems
            If Len(Ans$(KeyCnt, Col)) = 0 Then
                Print #2, "   "; 'Print spaces for no 2nd key/distractor entry
            Else
                Print #2, Format(Ans$(KeyCnt, Col), "  >"); 'KeyCnt tracks ans key
            End If
        Next Col
    Else
        Print #2,: Print #2,: Print #2, Spc(InpVarSize + 1); "Discrimination D:";
        For Col = 1 To NoTestItems
            If Recrd(NoStuRecs + 4, Col) = 100 Then
                Print #2, "100";
            Else
                If Recrd(NoStuRecs + 4, Col) < 0 Then
                    Print #2, Format(Recrd(NoStuRecs + 4, Col), "00");
                Else
                    Print #2, Format(Recrd(NoStuRecs + 4, Col), " 00");
                End If
            End If
        Next Col
        Print #2,: Print #2, Spc(InpVarSize + 7); "Biserial r:";
        For Col = 1 To NoTestItems
            If Recrd(NoStuRecs + 5, Col) = 100 Then
                Print #2, "100";
            Else
                If Recrd(NoStuRecs + 5, Col) < 0 Then
                    Print #2, Format(Recrd(NoStuRecs + 5, Col), "00");
                Else
                    Print #2, Format(Recrd(NoStuRecs + 5, Col), " 00");
                End If
            End If
        Next Col
        Print #2,: Print #2,: Print #2, Spc(InpVarSize + 3); "Keyed Response:";
        For Col = 1 To NoTestItems
            Print #2, Format(Ans$(1, Col), "  >"); '1st answer key
        Next Col
    End If
    'no of students and items and KR20
    Print #2,: Print #2,: Print #2, Spc(InpVarSize + 4); "  No Students:";: Print #2, Format(NoStuRecs, "###");
    Print #2, "   Items:";: Print #2, Format(NoTestItems, "###");
    Print #2, "     KR20:";: Print #2, Format(ZKR20, "###.##")
    'calc Mean student MCI and M item MCI
    Print #2, Spc(InpVarSize + 2); " Stdnt MCI Mean:";: ZMCIMean = SumStuMCI / NoStuRecs: Print #2, Format(ZMCIMean, "###");
    Print #2, Spc(6); " Item MCI Mean:";: ZIMCIMean = SumItMCI / NoTestItems: Print #2, Format(ZIMCIMean, "###")
    'student M and SD
    Print #2, Spc(InpVarSize + 2); " Stdnt Tot Mean:";: Print #2, Format(ZM, "###.##");
    Print #2, "   SD:";: Print #2, Format(ZSD, "###.##");
    Print #2, "    SEM:";: ZSEM = (ZSD * Sqr(1 - ZKR20)): Print #2, Format(ZSEM, "###.##")
    'calc M and SD for % correct
    ZPSD = Sqr((ZPSumSq - ((ZPSum * ZPSum) / NoStuRecs)) / NoStuRecs)
    ZPM = ZPSum / NoStuRecs
    Print #2, Spc(InpVarSize + 2); "Stdnt Raw% Mean:";: Print #2, Format(ZPM, "###.##");
    Print #2, "   SD:";: Print #2, Format(ZPSD, "###.##");
    Print #2, "   SEM:";: ZSEM = ZPSD * Sqr(1 - ZKR20): Print #2, Format(ZSEM, "###.##")
    Print #2,: Print #2,
    Pass = 2
    'count no lines Printed
    EdLongRow = EdLongRow + 13
End Sub

anthonya2369 · Dec 3, 2010

The reason the error is you are not specifying the file path to the TrailFildef$ since you have TrailerFile$ path referenced but no path/file reference for the file you are trying to print. If you go to that line and hit F9 and then run the code, you will notice that TrailFildef$ has a value of "" because of this. Just Change:

Code:

TrailerFile$ = "C:\Users\Mike\Desktop\CattraxStuff\Trailer.txt"

To:

Code:

TrailFildef$ = "C:\Users\Mike\Desktop\CattraxStuff\Trailer.txt"

Help with fixing a '52' error bad file name

mrb323

New Member

Excel Facts

anthonya2369

Active Member

Similar threads

Forum statistics

Share this page

Help with fixing a '52' error bad file name

mrb323

New Member

Excel Facts

anthonya2369

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock