none
Macro is getting an error type mismatch for importing a data RRS feed

  • Question

  • Our account specialist is using macro for importing and exporting files for years. She is getting an type mismatch error after windows 10 and office 2016 upgrade according to her. I tried to change datatype but still getting a same error message. Do you have any idea to solve this kind of issue? I am also attaching my xlsm file and also xls file.

    I attached vba code here.

    ' v.2 10/29/2002 ' used M for filespec
    '                   Locked cells
    '                   isnumeric validity check for phone number
    ' v.3 11/1/2002     three period type
    '                   import function added
    ' v.4 11/19/2002    Output 00's instead of blanks for dates
    '                    Output 000 for undetermined status
    '                   Add one to record count in header record
    ' v.5 11/21/2002    Output spaces instead of zeros for dates
    ' v1.0 12/4/2002    Added ad to picklist page, fixed spelling in A12
    ' v1.1 12/12/2002   Remove address requirement
    ' v1.2 12/27/2002   Problem with pull-down in A49
    ' v1.3 1/8/2003     Import fields in wrong order
    ' v1.4 2/13/03      replace future active '000' with '   '
    ' 10/15/2012 rch - added code to allow export file location, changed font to white to hide job category and job classification data
    
    
    
    
    
    Function Validate() As Boolean
    On Error GoTo Validate_Error
    
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim rgJobCategories As Range
    Dim rgJobClassification As Range
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
        Validate = True
        ' check the employer code is numeric
        If Not IsNumeric(rgEmployerData.Cells(1, 3).Value) Then
            MsgBox "Invalid Employer code.", vbCritical, "Entry error"
            Validate = False
        End If
        ' check the file start code is 3 characters
        If Len(Trim(rgEmployerData.Cells(2, 3).Value)) <> 3 Then
            MsgBox "Invalid File Start Code.", vbCritical, "Entry Error"
            Validate = False
        End If
        ' check monthly/bi-weekly code is a M, B1 or B2
        If Not IsNumeric(rgEmployerData.Cells(5, 3).Value) Or rgEmployerData.Cells(5, 3).Value < 1 Or rgEmployerData.Cells(5, 3).Value > 3 Then
            MsgBox "Invalid Payroll cycle", vbCritical, "Entry error"
            Validate = False
        End If
    
        ' check File Creation is a date
        If Not IsDate(rgEmployerData.Cells(6, 3).Value) Then
            MsgBox "Invalid Period Ending Date", vbCritical, "Entry Error"
            Validate = False
        End If
            
    For I = 1 To 500
        ' if this record as a SSN or last name check it.  Otherwise skip it.
        
        If Trim(rgEmployeeData.Cells(I, 3).Value) <> "" Or Trim(rgEmployeeData.Cells(I, 6).Value) <> "" Then
        
        ' check for valid SSN
            If Len(rgEmployeeData.Cells(I, 3).Value) <> 9 Then
                MsgBox "Invalid Social Security Number for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            If Not IsNumeric(rgEmployeeData.Cells(I, 3).Value) Then
                MsgBox "Invalid Social Security Number for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
        
        ' check for valid first
            If Len(rgEmployeeData.Cells(I, 4).Value) < 1 Then
                MsgBox "Invalid first name for " & rgEmployeeData.Cells(I, 3).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
        
        ' check for valid last
            If Len(rgEmployeeData.Cells(I, 6).Value) < 1 Then
                MsgBox "Invalid last name for " & rgEmployeeData.Cells(I, 3).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid sex
            If UCase(Left(rgEmployeeData.Cells(I, 8).Value, 1)) = "M" Or UCase(Left(rgEmployeeData.Cells(I, 8).Value, 1)) = "F" Then
            Else
            MsgBox "Invalid sex for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
                    
        ' check the birth date for validity
            If Not IsDate(rgEmployeeData.Cells(I, 9).Value) And Not rgEmployeeData.Cells(I, 9).Value = "" Then
                MsgBox "Invalid birth date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid address
        '    If Len(rgEmployeeData.Cells(I, 10).Value) < 1 Then
        '        MsgBox "Invalid address for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
        '        Validate = False
        '        Exit Function
        '    End If
            
        ' check for valid city
            If Len(rgEmployeeData.Cells(I, 13).Value) < 1 Then
                MsgBox "Invalid city for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid state
            If Len(rgEmployeeData.Cells(I, 14).Value) <> 2 Then
                MsgBox "Invalid state for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid zip
            If Len(rgEmployeeData.Cells(I, 15).Value) = 5 Or Len(rgEmployeeData.Cells(I, 15).Value) = 9 Then
            Else
            MsgBox "Invalid zip for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value, vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
        ' check for valid phone
            If Not IsNumeric(rgEmployeeData(I, 17).Value) Then
                MsgBox "Invalid phone for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value & " (Numbers only.)", vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
            If Len(rgEmployeeData.Cells(I, 17).Value) > 10 Then
            MsgBox "Invalid phone for " & rgEmployeeData.Cells(I, 4).Value & " " & rgEmployeeData.Cells(I, 6).Value & " (Exceeds 10 chars.)", vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
            
            
        ' check the hire date for validity
            If Not IsDate(rgEmployeeData.Cells(I, 19).Value) And Not rgEmployeeData.Cells(I, 19).Value = "" Then
                MsgBox "Invalid Hire date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
    '  check termination date
            If Not IsDate(rgEmployeeData.Cells(I, 20).Value) And Not rgEmployeeData.Cells(I, 20) = "" Then
                MsgBox "Invalid Termination date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            
    '  check Future Status date
            If rgEmployeeData.Cells(I, 21).Value <> "" Then
                If Not IsDate(rgEmployeeData.Cells(I, 21).Value) Then
                    MsgBox "Invalid future date for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                    Validate = False
                    Exit Function
                End If
            End If
            
        ' check for proper active/term status
            If rgEmployeeData.Cells(I, 21).Value <> "" Then
                If UCase(Left(rgEmployeeData.Cells(I, 22).Value, 1)) = "A" Or UCase(Left(rgEmployeeData.Cells(I, 8).Value, 1)) = "T" Then
                Else
                    MsgBox "Invalid Active/Term for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                    Validate = False
                    Exit Function
                End If
            End If
        ' check for proper FTE %
            If Not IsNumeric(rgEmployeeData.Cells(I, 23).Value) Then
                MsgBox "Invalid FTE % for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            If rgEmployeeData.Cells(I, 23).Value > 1 Or rgEmployeeData.Cells(I, 23).Value < 0 Then
                MsgBox "Invalid FTE % for " & Trim(rgEmployeeData.Cells(I, 4).Value) & " " & Trim(rgEmployeeData.Cells(I, 6).Value), vbCritical, "Entry Error"
                Validate = False
                Exit Function
            End If
            v = RecordCount
        
        End If
    Next I
    
        Exit Function
    
    Validate_Error:
        MsgBox Err.Description, vbCritical, "Validate"
    
    
    End Function
    
    
    Function RecordCount() As Integer
    ' this function will count the number of records ready to be transmitted
    
    On Error GoTo RecordCount_Error
    
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim R As Integer
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    RecordCount = 0
    For R = 1 To 500
        If Trim(rgEmployeeData.Cells(R, 3).Value) <> "" Or Trim(rgEmployeeData.Cells(R, 6).Value) <> "" Then
            RecordCount = RecordCount + 1
        End If
    Next R
    ' compare record count
        If RecordCount <> rgEmployerData.Cells(7, 3).Value Then
            MsgBox "Updating Record count to: " & RecordCount, vbInformation, "Updating record count"
            rgEmployerData.Cells(7, 3) = RecordCount
        End If
            
    
    
    Exit Function
    
    
    RecordCount_Error:
    MsgBox Err.Description, vbCritical, "RecordCount"
    
    End Function
    Sub cmdExport()
    On Error GoTo cmdExport_Error
    '
    '
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim rgJobCategories As Range
    Dim rgJobClassification As Range
    
    Dim R As Long, C As Long
    Dim FileSpec As String
    Dim PLine As String
    
    If Not Validate Then
        Exit Sub
    End If
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
    On Error GoTo File_Error
    
    If Right(rgEmployerData.Cells(9, 3).Value, 1) <> "\" Then
        rgEmployerData.Cells(9, 3).Value = rgEmployerData.Cells(9, 3).Value & "\"
    End If
    FileSpec = rgEmployerData.Cells(9, 3).Value & rgEmployerData.Cells(2, 3).Value & Format(rgEmployerData.Cells(6, 3).Value, "MM") & Right(Format(rgEmployerData.Cells(6, 3).Value, "yyyy"), 4) & "M.txt"
    Open FileSpec For Input As #1
    Close #1
     v = MsgBox("The file " & FileSpec & " already exits.", vbOKCancel)
     If v = vbCancel Then
        Exit Sub
     End If
    NewFile:
    Open FileSpec For Output As #1
    
    
    On Error GoTo cmdExport_Error
    
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
    ' first send the header record
        ' header id
        PLine = Format(Date, "mmdd")
        ' employer code
        PLine = PLine & Format(rgEmployerData.Cells(1, 3).Value, "0000000")
        ' record cound
        ' add 1 to the record count for the header record
        PLine = PLine & Format(rgEmployerData.Cells(7, 3).Value, "00000")
        ' File creation date period
        PLine = PLine & Format(rgEmployerData.Cells(6, 3).Value, "mmddyyyy")
        
        Print #1, PLine
    
    For R = 1 To 500
        ' if this record has a SSN or last name check it.  Otherwise skip it.
        
        If Trim(rgEmployeeData.Cells(R, 3).Value) <> "" Or Trim(rgEmployeeData.Cells(R, 6).Value) <> "" Then
        
        ' header id
            PLine = Format(Format(Date, "mmdd"), "0000")
        ' employer code
        PLine = PLine & Format(rgEmployerData.Cells(1, 3).Value, "0000000")
        ' billing entity code
            PLine = PLine & Format(rgEmployerData.Cells(4, 3).Value, "0000")
        ' agreement code
            PLine = PLine & Format(rgEmployerData.Cells(5, 3), "000000")
       ' site code
            PLine = PLine & "     "
        ' ssn
            PLine = PLine & Format(rgEmployeeData.Cells(R, 3), "000000000")
        ' last name
            PLine = PLine & Left((rgEmployeeData.Cells(R, 6).Value & Space(50)), 50)
        ' first name
            PLine = PLine & Left((rgEmployeeData.Cells(R, 4).Value & Space(50)), 50)
        ' middle
            PLine = PLine & Left((rgEmployeeData.Cells(R, 5).Value & Space(50)), 50)
        ' suffix
            PLine = PLine & Left((rgEmployeeData.Cells(R, 7).Value & Space(3)), 3)
        ' sex
            PLine = PLine & UCase(Left((rgEmployeeData.Cells(R, 8).Value & Space(3)), 1))
        ' birthdate
            PLine = PLine & Format(rgEmployeeData.Cells(R, 9).Value, "mmddyyyy")
        ' address 1
            PLine = PLine & Left((rgEmployeeData.Cells(R, 10).Value & Space(50)), 50)
        ' address 2
            PLine = PLine & Left((rgEmployeeData.Cells(R, 11).Value & Space(50)), 50)
        ' address 3
            PLine = PLine & Left((rgEmployeeData.Cells(R, 12).Value & Space(50)), 50)
        ' city
            PLine = PLine & Left((rgEmployeeData.Cells(R, 13).Value & Space(50)), 50)
        ' state
            PLine = PLine & Left((rgEmployeeData.Cells(R, 14).Value & Space(2)), 2)
        ' zip
            PLine = PLine & Left((rgEmployeeData.Cells(R, 15).Value & Space(9)), 9)
        ' country
            PLine = PLine & Left((rgEmployeeData.Cells(R, 16).Value & Space(3)), 3)
        ' phone
            PLine = PLine & Left((rgEmployeeData.Cells(R, 17).Value & Space(10)), 10)
        ' e-mail
            PLine = PLine & Left((rgEmployeeData.Cells(R, 18).Value & Space(30)), 30)
        ' job category
            Select Case rgEmployeeData.Cells(R, 1)
                Case 1
                    PLine = PLine & Left(rgJobCategories.Cells(1, 1) + Space(2), 2)
                Case 2
                    PLine = PLine & Left(rgJobCategories.Cells(2, 1) + Space(2), 2)
                Case 3
                    PLine = PLine & Left(rgJobCategories.Cells(3, 1) + Space(2), 2)
                Case 4
                    PLine = PLine & Left(rgJobCategories.Cells(4, 1) + Space(2), 2)
                Case 5
                    PLine = PLine & Left(rgJobCategories.Cells(5, 1) + Space(2), 2)
                Case 6
                    PLine = PLine & Left(rgJobCategories.Cells(6, 1) + Space(2), 2)
                Case 7
                    PLine = PLine & Left(rgJobCategories.Cells(7, 1) + Space(2), 2)
                Case 8
                    PLine = PLine & Left(rgJobCategories.Cells(8, 1) + Space(2), 2)
                Case Else
                    MsgBox "You have entered an invalid Job Category on row " & R & ".", vbCritical, "Invalid data"
                    Exit Sub
            End Select
        ' job classification
            Select Case rgEmployeeData.Cells(R, 2)
                Case 1
                    PLine = PLine & Left(rgJobClassifications.Cells(1, 1) + Space(2), 2)
                Case 2
                    PLine = PLine & Left(rgJobClassifications.Cells(2, 1) + Space(2), 2)
                Case 3
                    PLine = PLine & Left(rgJobClassifications.Cells(3, 1) + Space(2), 2)
                Case 4
                    PLine = PLine & Left(rgJobClassifications.Cells(4, 1) + Space(2), 2)
                Case Else
                    MsgBox "You have entered an invalid Job Category on row " & R & ".", vbCritical, "Invalid data"
                    Exit Sub
            End Select
    
        ' hire date
            If rgEmployeeData.Cells(R, 19).Value = "" Then
                PLine = PLine & Space(8)
            Else
                PLine = PLine & Format(rgEmployeeData.Cells(R, 19).Value, "mmddyyyy")
            End If
        ' termination date
            If rgEmployeeData.Cells(R, 20).Value = "" Then
                PLine = PLine & Space(8)
            Else
                PLine = PLine & Format(rgEmployeeData.Cells(R, 20).Value, "mmddyyyy")
            End If
        ' future status date
            If rgEmployeeData.Cells(R, 21).Value = "" Then
                PLine = PLine & Space(8)
            Else
                PLine = PLine & Format(rgEmployeeData.Cells(R, 21).Value, "mmddyyyy")
            End If
        ' future status
            Select Case UCase(Left(rgEmployeeData.Cells(R, 22), 1))
            Case "A"
                PLine = PLine & "ACT"
            Case "T"
                PLine = PLine & "TRM"
            Case Else
                PLine = PLine & "   "
            End Select
            
        
        ' fte percentage
            PLine = PLine & Format(rgEmployeeData.Cells(R, 23).Value * 100, "000")
            Print #1, PLine
        End If
    Next R
    
    Close #1
    MsgBox "Export file: " & FileSpec & " created.", vbInformation, "Success"
    Exit Sub
    
    cmdExport_Error:
            MsgBox Err.Description, vbCritical, "cmdExport"
            Exit Sub
    
    File_Error:
        'MsgBox Err.Number
        If Err.Number = 53 Then ' file not found
            Resume NewFile:
        Else
            MsgBox Err.Number, Err.Description, vbc, "cmdExport"
            Resume Next
        End If
    
    End Sub
    
    Sub Showform()
        Load MemberForm
        MemberForm.Show
    End Sub
    
    Sub Import()
    On Error GoTo Import_Error
    '
    '
    Dim rgEmployeeData As Range
    Dim rgEmployerData As Range
    Dim rgJobCategories As Range
    Dim rgJobClassification As Range
    
    Dim R As Long, C As Long
    Dim FileSpec As String
    Dim PLine As String
    Dim JobCategory, JobClassifiction, SSN, FName, MName, Lname, Suffix, Active, Gross, Member, Total, FTE, HireDate, TerminationDate As String
     Dim Inrec As String
    
    Set rgEmployeeData = Range("Employeedata")
    Set rgEmployerData = Range("employerdata")
    Set rgJobCategories = Range("jobcategories")
    Set rgJobClassifications = Range("jobclassifications")
    
    ' clear the rows
    For R = 1 To 500
        For C = 1 To 23
            rgEmployeeData.Cells(R, C).Value = ""
        Next C
    Next R
    R = 0
    
    On Error GoTo File_Error
    FileSpec = rgEmployerData.Cells(8, 3).Value
    Open FileSpec For Input As #1
    
    
    On Error GoTo Import_Error
    
    Do While Not EOF(1)
    Line Input #1, Inrec
        R = R + 1
    
        ' job category
                x = UCase(Trim(ParseInrec(Inrec, 1)))
            Select Case UCase(Trim(ParseInrec(Inrec, 17)))
                Case "R"
                    rgEmployeeData.Cells(R, 1) = 1
                Case "RT"
                    rgEmployeeData.Cells(R, 1) = 2
                Case "RP"
                    rgEmployeeData.Cells(R, 1) = 3
                Case "AP"
                    rgEmployeeData.Cells(R, 1) = 4
                Case "RE"
                    rgEmployeeData.Cells(R, 1) = 5
                Case "RW"
                    rgEmployeeData.Cells(R, 1) = 6
                Case "LW"
                    rgEmployeeData.Cells(R, 1) = 7
                Case "PT"
                    rgEmployeeData.Cells(R, 1) = 8
                Case Else
                    MsgBox "Invalid Job Category in input file row " & R, vbCritical, "Import Error"
                    Exit Sub
            End Select
        ' job classification
            Select Case UCase(Trim(ParseInrec(Inrec, 18)))
                Case "AD"
                    rgEmployeeData.Cells(R, 2) = 1
                Case "TE"
                    rgEmployeeData.Cells(R, 2) = 2
                Case "OC"
                    rgEmployeeData.Cells(R, 2) = 3
                Case "NC"
                    rgEmployeeData.Cells(R, 2) = 4
                Case Else
                    MsgBox "Invalid Job Classification in input file row " & R, vbCritical, "Import Error"
                    Exit Sub
            End Select
        ' ssn
            rgEmployeeData.Cells(R, 3).Value = UCase(Trim(ParseInrec(Inrec, 1)))
        ' last name
            If Len(ParseInrec(Inrec, 2)) = 0 Then
                MsgBox "Missing Last Name in input file row " & R, vbCritical, "Import Error"
            Else
                rgEmployeeData.Cells(R, 6).Value = Trim(ParseInrec(Inrec, 2))
            End If
        ' first name
            rgEmployeeData.Cells(R, 4).Value = Trim(ParseInrec(Inrec, 3))
        ' initial
            rgEmployeeData.Cells(R, 5).Value = Trim(ParseInrec(Inrec, 4))
        ' suffix
            rgEmployeeData.Cells(R, 7).Value = Trim(ParseInrec(Inrec, 5))
        ' sEX
        If Left(UCase(Trim(ParseInrec(Inrec, 6))), 1) = "M" Then
            rgEmployeeData.Cells(R, 8).Value = "M"
        End If
        If Left(UCase(Trim(ParseInrec(Inrec, 6))), 1) = "F" Then
            rgEmployeeData.Cells(R, 8).Value = "F"
        End If
        ' Birthday
        If IsDate(ParseInrec(Inrec, 7)) Or Trim(ParseInrec(Inrec, 7)) = "" Then
            rgEmployeeData.Cells(R, 9).Value = Trim(ParseInrec(Inrec, 7))
        Else
            MsgBox "Non-date entry for Birth Date found in input file row " & R, vbCritical, "Import Error"
        End If
        ' Address1
        rgEmployeeData.Cells(R, 10).Value = Trim(ParseInrec(Inrec, 8))
        ' address2
        rgEmployeeData.Cells(R, 11).Value = Trim(ParseInrec(Inrec, 9))
        ' address3
        rgEmployeeData.Cells(R, 12).Value = Trim(ParseInrec(Inrec, 10))
        ' city
        rgEmployeeData.Cells(R, 13).Value = Trim(ParseInrec(Inrec, 11))
        ' state
        rgEmployeeData.Cells(R, 14).Value = UCase(Trim(ParseInrec(Inrec, 12)))
        ' zip
        If IsNumeric(Trim(ParseInrec(Inrec, 13))) Or Trim(ParseInrec(Inrec, 13)) = "" Then
            rgEmployeeData.Cells(R, 15).Value = Trim(ParseInrec(Inrec, 13))
        Else
            MsgBox "Non-numeric entry for Zip Code found in input file row " & R, vbCritical, "Import Error"
        End If
        ' Country
        rgEmployeeData.Cells(R, 16).Value = Trim(ParseInrec(Inrec, 14))
        ' phone
        If IsNumeric(Trim(ParseInrec(Inrec, 15))) Or Trim(ParseInrec(Inrec, 15)) = "" Then
            rgEmployeeData.Cells(R, 17).Value = Trim(ParseInrec(Inrec, 15))
        Else
            MsgBox "Non-numeric entry for Phone found in input file row " & R, vbCritical, "Import Error"
        End If
        ' e-mail
        rgEmployeeData.Cells(R, 18).Value = Trim(ParseInrec(Inrec, 16))
        ' hire date
        If IsDate(ParseInrec(Inrec, 19)) Or Trim(ParseInrec(Inrec, 19)) = "" Then
            rgEmployeeData.Cells(R, 19).Value = Trim(ParseInrec(Inrec, 19))
        Else
            MsgBox "Non-date entry for Hire Date found in input file row " & R, vbCritical, "Import Error"
        End If
        ' term date
        If IsDate(ParseInrec(Inrec, 20)) Or Trim(ParseInrec(Inrec, 20)) = "" Then
            rgEmployeeData.Cells(R, 20).Value = Trim(ParseInrec(Inrec, 20))
        Else
            MsgBox "Non-date entry for Termination Date found in input file row " & R, vbCritical, "Import Error"
        End If
        '  future date
        If IsDate(ParseInrec(Inrec, 21)) Or Trim(ParseInrec(Inrec, 21)) = "" Then
            rgEmployeeData.Cells(R, 21).Value = Trim(ParseInrec(Inrec, 21))
        Else
            MsgBox "Non-date entry for Future Date found in input file row " & R, vbCritical, "Import Error"
        End If
        ' future status
        rgEmployeeData.Cells(R, 22).Value = UCase(Trim(ParseInrec(Inrec, 22)))
        ' FTE
        If IsNumeric(ParseInrec(Inrec, 23)) Then
            rgEmployeeData.Cells(R, 23).Value = ParseInrec(Inrec, 23) / 100
        Else
            MsgBox "Non-numeric entry for FTE found in input file row " & R, vbCritical, "Import Error"
        End If
        
        
        'rgEmployerData.Cells(7, 3).Value = R
        
        Loop
    
    Close #1
    MsgBox "Import completed. " & R & " rows imported.", vbInformation, "Success"
    Exit Sub
    
    Import_Error:
        MsgBox Err.Description & " Record: " & Inrec, vbCritical, "Import"
        Exit Sub
    
    File_Error:
        'MsgBox Err.Number
        If Err.Number = 53 Then ' file not found
            MsgBox "Input file not found.", vbCritical, "Bad filename"
            
        Else
            MsgBox Err.Number, Err.Description, vbc, "Import"
            Resume Next
        End If
    
    
    End Sub
    Function ParseInrec(Inrec, FieldNo)
        On Error GoTo ParseInrec_Error
        Dim Inrec2 As String
        Dim I As Integer
        
        Select Case FieldNo
            Case Is = 1
                Inrec2 = Inrec
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 2
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 3
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 4
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 5
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 6
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 7
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 8
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 9
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 10
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 11
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
    
            Case Is = 12
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 13
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 14
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 15
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 16
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 17
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 18
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 19
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 20
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 21
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 22
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
            Case Is = 23
                Inrec2 = Right(Inrec, Len(Inrec) - (InStr(1, Inrec, ",")))
                For I = 1 To FieldNo - 2
                    Inrec2 = Right(Inrec2, Len(Inrec2) - (InStr(1, Inrec2, ",")))
                Next I
                 ParseInrec = Left(Inrec2, (InStr(1, Inrec2, ",") - 1))
       
       
        End Select
        Exit Function
    
    ParseInrec_Error:
    
        MsgBox Err.Description & " R/F: " & R & " " * FieldNo, vbCritical, "ParseInrec"
        
    End Function



    Virtual Reality

    Tuesday, August 30, 2016 10:35 AM

Answers

  • Hi VR16,

    Do you import the data like below?

    PK!bîh^[Content_Types].xml ¢( ¬”ËNÃ0E÷HüCä-Jܲ@5í‚Ç*Q>Àēƪc[žiiÿž‰ûB¡j7±ÏÜ{2ñÍh²nm¶‚ˆÆ»R‹ÈÀU^7/ÅÇì%¿’rZYï @1__f›˜q·ÃR4DáAJ¬
    

    when I test your code. I find that it is taking data like this from the Demo.xlsx

    so it starting to throw an error from line below.

     x = UCase(Trim(ParseInrec(Inrec, 1)))

    if that string is not the one which you want to import then I think problem is in Line Input # Statement .

    for more information regarding Line Input # Statement visit the link below.

    Line Input # Statement

    I also try to reproduce this issue and try to import line from the file with the code mentioned below and I got the same output.

    Sub demo()
    Dim TextLine, TESTFILE As String
    TESTFILE = "C:\Users\v-padee\Desktop\test\demo.xlsx"
    Open TESTFILE For Input As #1   ' Open file.
    Do While Not EOF(1)   ' Loop until end of file.
       Line Input #1, TextLine   ' Read line into variable.
       Debug.Print TextLine   ' Print to the Immediate window.
    Loop
    Close #1   ' Close file.
    
    End Sub

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, September 1, 2016 8:34 AM
    Moderator

All replies

  • Hi VR16,

    First of all I want to inform you that support for Office 2003 has been ended.

    so may be it is possible that some feature get changed in Excel 2016.

    so you need to change that things in your code to make it again working.

    The other thing I want to tell you that you can post only that much code that have issue with it instead of posting long code. because it makes community members confused and it take much time to find the things in that.

    we don't have your files to import so we don't know what the file contents and so that we are not able to test the above mentioned code.

    from the picture of Error line. we can only know that the code trying to catch error regarding Type Mismatch.

    but where in the code? on which line?

    also I want to confirm with you what is your last version of Excel on which this code is working.

    also I want to know which type , version of file you are trying to import?

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, August 31, 2016 3:23 AM
    Moderator
  • We were using excel 2010 before as per our account specialist.

    I will take care of this next time. I apologize for that.

    I am trying to import excel 2016 file.

    I couldn't attach xlsm file here.They donot provide any option to attach xlsm file.

    Thanks


    Virtual Reality

    Wednesday, August 31, 2016 8:51 PM
  • Hi VR16,

    you can use free Sharing and uploading websites like dropbox. there are many this kind of websites available.

    you can upload your XSLM file and Demo importing file there and then you need to share the link of uploaded project here in this thread.

    so that we can try to download it and test it.

    Hope it helps to you to understand how you can share your demo test solution with us.

    Note:- We don't Require your confidential data. so if your file contains any confidential data then replace it with dummy data. The only thing is that it should able to reproduce the issue on our side.

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, September 1, 2016 3:27 AM
    Moderator
  • Hello,

    Thanks for your help and suggestion.

    I am attaching link here which contains xlsm with its importing xls file.

    https://drive.google.com/folderview?id=0B2IiJZCmo2WudGdPZUgweEZlbVk&usp=sharing

    Thanks


    Virtual Reality

    Thursday, September 1, 2016 4:25 AM
  • Hi VR16,

    Do you import the data like below?

    PK!bîh^[Content_Types].xml ¢( ¬”ËNÃ0E÷HüCä-Jܲ@5í‚Ç*Q>Àēƪc[žiiÿž‰ûB¡j7±ÏÜ{2ñÍh²nm¶‚ˆÆ»R‹ÈÀU^7/ÅÇì%¿’rZYï @1__f›˜q·ÃR4DáAJ¬
    

    when I test your code. I find that it is taking data like this from the Demo.xlsx

    so it starting to throw an error from line below.

     x = UCase(Trim(ParseInrec(Inrec, 1)))

    if that string is not the one which you want to import then I think problem is in Line Input # Statement .

    for more information regarding Line Input # Statement visit the link below.

    Line Input # Statement

    I also try to reproduce this issue and try to import line from the file with the code mentioned below and I got the same output.

    Sub demo()
    Dim TextLine, TESTFILE As String
    TESTFILE = "C:\Users\v-padee\Desktop\test\demo.xlsx"
    Open TESTFILE For Input As #1   ' Open file.
    Do While Not EOF(1)   ' Loop until end of file.
       Line Input #1, TextLine   ' Read line into variable.
       Debug.Print TextLine   ' Print to the Immediate window.
    Loop
    Close #1   ' Close file.
    
    End Sub

    Regards

    Deepak


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, September 1, 2016 8:34 AM
    Moderator