Invalid character in import string (1 Viewer)

[wjburke2]

I have a program that has been working for a year or so, it imports records form a text file created by a web site. Someone has entered a hex("1A", "A8" in a name field. It is shutting my program down. I tried a alphanumeric check to replace it and a length check to try and skip the record but the program thinks it is at the end of the file and quits reading records. Is there a way to get rid of characters like this in vba?

"5407 MUYF3I23 GIS¨LE "

Here is what I have tried

             If Len(strread) <> 591 Then
                MsgBox "Invalid Record Read " & strread
                GoTo Skip_Loop
            End If
  
              If AlphaNumeric(CStr(Trim(Mid(strread, 32, 11)))) Then
                 !HT_FName = CStr(Trim(Mid(strread, 32, 11)))
             Else
                 MsgBox "Invalid name"
             End If
  
 Function AlphaNumeric(pValue) As Boolean
    Dim LPos As Integer
   Dim LChar As String
   Dim LValid_Values As String
   
   'Start at first character in pValue
   LPos = 1
   
   'Set up values that are considered to be alphanumeric
   LValid_Values = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ+-.0123456789"
   
   'Test each character in pValue
   While LPos <= Len(pValue)
   
      'Single character in pValue
      LChar = Mid(pValue, LPos, 1)
      
      'If character is not alphanumeric, return FALSE
      If InStr(LValid_Values, LChar) = 0 Then
         AlphaNumeric = False
         Exit Function
      End If
      
      'Increment counter
       LPos = LPos + 1
       
   Wend
    
   'Value is alphanumeric, return TRUE
   AlphaNumeric = True
    
End Function

 

[jdraw]

Here is a function from Dev Ashish that may be of interest to you.
You can use it or adjust to meet your needs.

Here is a small proc to show Ascii chars

Sub testAscii()
       Dim i As Integer
 10     For i = 0 To 127 '255
20        Debug.Print i; Chr(i)
30      Next i
      
End Sub

 

[vbaInet]

What is your import routine?

 

[wjburke2]

Thanks JDraw, I have a program that allows me to see what the characters are its called V File Viewer. In this case the invalid character is causing a EOF so any attempt to display it fails. My records are 658 bytes long but this causes the record to appear as 35 bytes and triggers a EOF. ASCII 1A is a "Substitute" I believe it a command of some type.
This is a simple #ingFile read. parsing the file with mid(). I was able to trace the bad characters back to the Mainframe file and eliminate them before the download. So I guess that's my fix for now. it would be neat to create a program to zap unprintable characters on the PC side in case the Mainframe intermediate step goes away.

 

[vbaInet]

This is a simple #ingFile read. parsing the file with mid().

Would be nice to see it

 

[wjburke2]

I had removed the check and put it back here. As you can see it was only checking the first name. I tried moving it up to check the whole record but that didn't work. So if you find a code error it probably the cause. Thanks again for your help.

Public Sub ParseHistoryFile(ByVal inFileName As String, ByRef strCycledate As String)
On Error GoTo ParseHistoryFile_Err
     Dim strFileName As String
    Dim CancelLoad As Boolean
    Dim ing1 As Integer
    Dim Str As String
    
    Dim lngFile As Integer
    Dim strread As String
    Dim x As Long
    
    Dim lngTotalRet As Long
    Dim strCreateDate As String
    
    Dim ingMaxValue As Long
    Dim ingUpmeter As Long
    Dim ingMeterTrigger As Long
    
'   ***********************************************
'   ****       Setup the prograss meter         ***
'   ***********************************************
    Dim frm As Form
    Set frm = Screen.ActiveForm
    ingUpmeter = 0
    ingMaxValue = 100
    
    'ingMeterTrigger = Int(Abs(FileLen(inFileName) / 593) / 100)
    ingMeterTrigger = GetTrigerSize(inFileName, 593)
    ProgMeterCntl 1, frm, ingMaxValue, "ProgressBar1"
 '   ***********************************************
'   ****         Create Work Table              ***
'   ***********************************************
    Dim rstReturn As DAO.Recordset
    Set rstReturn = CurrentDb.OpenRecordset("TBO_Mail_Data")
     Dim rstDrops As DAO.Recordset
    Set rstDrops = CurrentDb.OpenRecordset("Mail_History_Dups")
    
    TotalRead = 0
    
    dtAccumDate = Now
    
    lngFile = FreeFile
    Open inFileName For Input As #lngFile
    
    Do While Not EOF(lngFile)
        Line Input #lngFile, strread
        x = x + 1
        If Not (Trim(strread) = "") Then 'Ignore blank line
            Str = CStr(Trim(Mid(strread, 223, 4)))
            If DCount("JobNum", "TBO_Jobs_Table", "JobNum ='" & Str & "'") = 0 Then
                Call Create_Job(Str, strCycledate)
            End If
            
            TotalRead = TotalRead + 1
            ingUpmeter = ingUpmeter + 1
             If Len(strread) <> 591 Then
                MsgBox "Invalid Record Read " & strread
                GoTo Skip_Loop
            End If
           
            rstReturn.AddNew
            With rstReturn
                ' Key value
                !HT_JobNum = CStr(Trim(Mid(strread, 223, 4)))
                !HT_SerNum = CStr(Trim(Mid(strread, 574, 9)))
                !JT_CycleDate = strCycledate
                
                !HT_Mail_BID = CStr(Trim(Mid(strread, 563, 2)))
                !HT_Mail_STID = CStr(Trim(Mid(strread, 565, 3)))
                !HT_Mailer_Id = CStr(Trim(Mid(strread, 568, 6)))
                !HT_ZIP5 = CStr(Trim(Mid(strread, 1, 5)))
                !HT_Zip4 = CStr(Trim(Mid(strread, 6, 4)))
                !HT_DPBC = CStr(Trim(Mid(strread, 131, 2)))
                
  ' Address data 
            
             If AlphaNumeric(CStr(Trim(Mid(strread, 32, 11)))) Then
                     !HT_FName = CStr(Trim(Mid(strread, 32, 11)))
             Else
                     MsgBox "Invalid name"
             End If
                '!HT_FName = CStr(Trim(Mid(strread, 32, 11)))
                !HT_MI = CStr(Trim(Mid(strread, 53, 1)))
                !HT_LName = CStr(Trim(Mid(strread, 54, 13)))
                !HT_Sfx = CStr(Trim(Mid(strread, 67, 3)))
                !HT_Addr = CStr(Trim(Mid(strread, 70, 41)))
                !HT_City = CStr(Trim(Mid(strread, 111, 13)))
                !HT_State = CStr(Trim(Mid(strread, 124, 2)))
                !HT_SrcCode = CStr(Trim(Mid(strread, 21, 10)))
                !HT_SeqNum = CStr(Trim(Mid(strread, 187, 11)))
                !HT_Form = CStr(Trim(Mid(strread, 10, 5)))
                !HT_Pkg = CStr(Trim(Mid(strread, 17, 1)))
                
                ' DPV Data
                !HT_DPV_Gen = CStr(Trim(Mid(strread, 43, 1)))
                !HT_NonDel = CStr(Trim(Mid(strread, 18, 1)))
                !HT_NoStat = CStr(Trim(Mid(strread, 19, 1)))
                !HT_Vacant = CStr(Trim(Mid(strread, 20, 1)))
                
                ' Truck info
                !HT_TrkDest = CStr(Trim(Mid(strread, 135, 3)))
                !HT_TrkDestE = CStr(Trim(Mid(strread, 135, 8)))
                !HT_SortLevel = CStr(Trim(Mid(strread, 138, 1)))
                !HT_Pallet_Num = CStr(Trim(Mid(strread, 498, 9)))
                !HT_Tray_Num = CStr(Trim(Mid(strread, 489, 8)))
                !HT_Tray_Type = CStr(Trim(Mid(strread, 513, 1)))
                
                ' Discount Info
                !HT_Mail_Class = CStr(Trim(Mid(strread, 514, 1)))
                !HT_Price_Ter = CStr(Trim(Mid(strread, 515, 1)))
                !HT_Post_Qal = CStr(Trim(Mid(strread, 516, 1)))
                !HT_Bar_Disc = CStr(Trim(Mid(strread, 521, 1)))
                !HT_CARR_Disc = CStr(Trim(Mid(strread, 522, 1)))
                !HT_Dest_Disc = CStr(Trim(Mid(strread, 523, 1)))
                !HT_Presort = CStr(Trim(Mid(strread, 524, 1)))
    
                !HT_ZIP3 = CStr(Trim(Mid(strread, 1, 3)))
                
                !AccumDate = dtAccumDate
                
            End With
            
            If ingUpmeter = ingMeterTrigger Then
                ProgMeterCntl 0
                ingUpmeter = 0
                frm.lblCount.Caption = CStr(TotalRead)
                DoEvents
            End If
                 
            rstReturn.Update
Skip_Loop:
        
        End If
        
        If CancelLoad Then
            Exit Do
        End If
    
    Loop
   
ParseHistoryFile_exit:
 
    Close #lngFile
    rstReturn.Close
    
    ProgMeterCntl 2
    frm.lblCount.Caption = CStr(TotalRead)
    
    Exit Sub
    
ParseHistoryFile_Err:
    
    Dim i As Long
    Str = ""
    For i = 0 To Errors.Count - 1
        Str = Str & Errors(i).Number & "-" & Errors(i).Description & " " & vbNewLine
    Next i
    
    If Str = "" Then
        If Err.Number > 0 Then
            Str = Err.Number & " - " & Err.Description
        Else
            GoTo Exit_ParseHistoryFile_Err
        End If
    End If
    
    If Str > "" Then
        rstDrops.AddNew
        rstDrops!HT_SerNum = Right(strread, 9)
        rstDrops!HT_Scan_Date = CDate(Trim(Mid(strread, 11, 19)))
        rstDrops!ErrorNumber = Mid(Str, 1, InStr(Str, "-"))
        rstDrops!ErrorDescription = Left(Str, 255)
        rstDrops!TR_Return_Record = strread
        rstDrops!AccumDate = Date
        rstDrops.Update
        If MsgBox(Str, vbOKCancel, "History Update") = vbCancel Then
            CancelLoad = True
        End If
        
    End If
    
Exit_ParseHistoryFile_Err:
     Resume Next
        
End Sub

 

[vbaInet]

Opening the file as Binary (because of the unicode chars) would have avoided this problem.

Another method would be to use the FileSystemObject and again open the file as unicode using the TristateTrue format, would also solve this problem.

 

[wjburke2]

Thanks I will give that a try. I am not sure if I follow the open as binary methodology completely. I assume I can then read the record without triggering a EOF. pass the strread by ref to Alphanumeric, strip the bad stuff and keep going. I will post my final solution.

 

[vbaInet]

The easiest option is FileSystemObject.

 

[jdraw]

Glad you have it resolved. Always best to clean the data as close to source as practical.