?
Solved

vb6 parse text file using split function

Posted on 2011-03-04
9
Medium Priority
?
510 Views
Last Modified: 2012-05-11
I have a script that reads a text file and parses out the strings and writes them to another text file.  I have recently started getting a few bad records in the destination text file where the timestamp and closing quote is left off the date time stamp.  

In the 2 strings in allmoves.txt (source file) below, the first one goes into the destination file,  morv.imp correctly.  The time stamp and the closing quote is left off the second record.

I have attached text files with the the complete records.

allmoves.txt
"MORV00","DBG","03/03/2011","008:01:22","0","C",.....
"MORV00","DBG","03/03/2011","009:02:45","0","C",.....

morv.imp
"MORV00","DBG","03/03/2011 08:01:22",,"0","C",.....
"MORV00","DBG","03/03/2011 ,,"0","C",........
Function Main()

    	TheDir = "c:\test\"
    	NewDir = "c:\testnew"
	X = ""
    	Set fso = CreateObject("Scripting.FileSystemObject")
    
    	Set M = fso.CreateTextFile(NewDir & "inva.imp")
    	Set N = fso.CreateTextFile(NewDir & "imtr.imp")
    	Set O = fso.CreateTextFile(NewDir & "morv.imp")
    	Set P = fso.OpenTextFile(NewDir & "ALLMOVES.TXT")
 
    	sLine = P.ReadLine
	Do While sLine <> ""
        		if Left(sLine,1) = """" Then

			X = mid(sline, 2, 4)
			if X = "IMTR" then
				sCOMT = Split(sLine, ",", 24, 1)
			elseif X = "INVA" then
				sCOMT = Split(sLine, ",", 22, 1)
			elseif X = "MORV" then
				sCOMT = Split(sLine, ",", 40, 1)
			end if
			if sCOMT(4) = """9""" or sCOMT(4) = """0""" then
				sCOMT(2) = left(sCOMT(2), 11) & " " & right(sCOMT(3),9)
				sCOMT(3) = ""
				if sCOMT(0) = """MORV00""" then 
					sCOMT(39) = ""
					if sCOMT(34) = """""" then 
						sCOMT(34) ="N"
					end if
				elseif sCOMT(0) = """IMTR01""" then 
					sCOMT(23) = ""
				elseif sCOMT(0) = """INVA01""" then 
					sCOMT(21) = ""
				end if
				sLine = Join(sCOMT, ",")
	
			        	If Mid(sLine, 2, 4) = "IMTR" Then
			            		N.WriteLine (sLine)
		        		ElseIf Mid(sLine, 2, 4) = "MORV" Then
		            			O.WriteLine (sLine)
			        	ElseIf Mid(sLine, 2, 4) = "INVA" Then
					sLine = Replace(sLine, ",.,", ",.0,")
			            		M.WriteLine (sLine)
		        		End If

	        		End If
         		end if

        		if not P.AtEndOfStream then
            			sLine = P.ReadLine
        		else
             			exit do
        		end if
    	Loop

    	P.Close
    	O.Close
    	N.Close
    	M.Close


    	Main = DTSTaskExecResult_Success

End Function

Open in new window

ALLMOVES.txt
morv.txt
0
Comment
Question by:Delta7428
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
9 Comments
 
LVL 10

Expert Comment

by:borgunit
ID: 35040164
I gave the program a shot and it worked. Does it work sometimes and then other time no?
0
 

Author Comment

by:Delta7428
ID: 35040214
Yes it has been working.  All of a sudden, it generated a couple of bad records 3 days in a row this week.   I have searched for something out of kilter in the source record that would cause it.  Nothing that I can find.
0
 
LVL 10

Expert Comment

by:borgunit
ID: 35040643
Sorry, but I need to ask. Are these the "exact files" that the error came from?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 10

Expert Comment

by:borgunit
ID: 35044496
If it is hard to track you might need a verification sub to handle it.
0
 

Author Comment

by:Delta7428
ID: 35055180
The attachments were exact sample records from the files.  Attached are the exact complete files.  I changed the extensions from imp to txt so they would attach.

Allmoves.txt is the source file.  Inva, Morv and Imtr are the destination files.  Inva has 1 bad record on line 252.  Morv has 1 bad record on line 94.  Imtr formatted correctly.  All other records in Inva and Morv formatted correctly.

What do I need as far as a verification sub?
AllMoveS.txt
morv.txt
inva.txt
imtr.txt
0
 
LVL 10

Accepted Solution

by:
borgunit earned 1500 total points
ID: 35055569
The sub could check for string length or use the LIKE method.

If len(expected string) <> 9 then

or

if not expectedstring LIKE "###:##:##" then

That sort of thing
0
 

Author Comment

by:Delta7428
ID: 35070771
I discovered the "bad records" are actually dups of the preceding line, minus the time stamp and closing quote.  It seems the line is being read twice for some reason.    If you see anything that jumps out at you, let me know.  I'm still troubleshooting ... off and on when I'm not pulled away on something else.  
"INVA01","BGG","03/07/2011","018:22:28","0","C","TPDLAW","NW","STAGE","O","NWIMTR","+",2,"R","01-000-0000-50401",2.96,2,1.48,"EA","N","","","","","","","","","","","","",,"","","","","","","","","","","","","","","","","","",.92,.56,.00,.00
"INVA01","BGG","03/07/2011","018:22:28","0","C","TPOSNP","NW","STAGE","O","NWIMTR","+",2,"R","01-000-0000-50401",4.42,2,2.21,"EA","N","","","","","","","","","","","","",,"","","","","","","","","","","","","","","","","","",1.57,.64,.00,.00

Function Main()

    	TheDir = "\\Mwwdc\MWW1\fs\mfgsys\" 				'"\\mww1\sys\fs\mfgsys\"
    	NewDir = "\\Mwwdc\MWW1\fs\mfgsys\MOVEFLDR\"			'"\\mww1\sys\fs\mfgsys\MOVEFLDR\"
	X = ""
    	Set fso = CreateObject("Scripting.FileSystemObject")
'    	Set A = fso.GetFile(NewDir & "fshift.imp")				'Change the file name to fshift.*** in case if you want to import data from a different file (in case if you forget to import)
'    	A.Copy NewDir & "fshift.imp"
    
    	Set M = fso.CreateTextFile(NewDir & "inva.imp")
    	Set N = fso.CreateTextFile(NewDir & "imtr.imp")
    	Set O = fso.CreateTextFile(NewDir & "morv.imp")
    	Set P = fso.OpenTextFile(NewDir & "ALLMOVES.TXT")
 
    	sLine = P.ReadLine
'    	iCount=0
	Do While sLine <> ""
        		if Left(sLine,1) = """" Then
'			iCount=iCount + 1
'			if iCount >5 then exit Do
			X = mid(sline, 2, 4)
			if X = "IMTR" then
				sCOMT = Split(sLine, ",", 24, 1)
			elseif X = "INVA" then
				sCOMT = Split(sLine, ",", 22, 1)
			elseif X = "MORV" then
				sCOMT = Split(sLine, ",", 40, 1)
			end if
			if sCOMT(4) = """9""" or sCOMT(4) = """0""" then
				sCOMT(2) = left(sCOMT(2), 11) & " " & right(sCOMT(3),9)
				sCOMT(3) = ""
				if sCOMT(0) = """MORV00""" then 
					sCOMT(39) = ""
					if sCOMT(34) = """""" then 
						sCOMT(34) ="N"
					end if
				elseif sCOMT(0) = """IMTR01""" then 
					sCOMT(23) = ""
				elseif sCOMT(0) = """INVA01""" then 
					sCOMT(21) = ""
				end if
				sLine = Join(sCOMT, ",")
	
			        	If Mid(sLine, 2, 4) = "IMTR" Then
			            		N.WriteLine (sLine)
		        		ElseIf Mid(sLine, 2, 4) = "MORV" Then
		            			O.WriteLine (sLine)
			        	ElseIf Mid(sLine, 2, 4) = "INVA" Then
					sLine = Replace(sLine, ",.,", ",.0,")
			            		M.WriteLine (sLine)
		        		End If
'			else
'				msgbox "--------" & sCOMT(4) & "--------"
'				exit do
	        		End If
         		end if

        		if not P.AtEndOfStream then
            			sLine = P.ReadLine
        		else
             			exit do
        		end if
    	Loop

    	P.Close
    	O.Close
    	N.Close
    	M.Close

'    	Set P = fso.GetFile(NewDir & "fshift.imp")
'    	P.Delete
    	Main = DTSTaskExecResult_Success

End Function

Open in new window

0
 

Author Comment

by:Delta7428
ID: 35072215
The duplicate records were not being read twice as I thought but somehow they are being written twice.  The second write is minus the time stamp.  I can't figure out why it's doing that so as a work around I am checking the writeline for the presence of the next field in the position which would normally be the date stamp before writing it.  That will always be "0".  

sCrap = """" & "0" & """"
If Mid(sline, 30, 3) <> sCrap Then
      M.WriteLine (sline)
end if

If Mid(sline, 30, 3) <> sCrap Then
         O.WriteLine (sline)
End If

I am open to the real solution to the real problem if anyone has one.  Otherwise I'll live with this for now.
Function Main()
Dim iCount As Integer
        TheDir = "c:\0"
        NewDir = "c:\test"
        
        sCrap = """" & "0" & """"
        
        x = ""
        Set fso = CreateObject("Scripting.FileSystemObject")
    
        Set M = fso.CreateTextFile(NewDir & "inva.imp")
        Set N = fso.CreateTextFile(NewDir & "imtr.imp")
        Set O = fso.CreateTextFile(NewDir & "morv.imp")
        Set P = fso.OpenTextFile(NewDir & "ALLMOVES.TXT")
 
        sline = P.ReadLine
    Do While sline <> ""
        If Left(sline, 1) = """" Then
            x = Mid(sline, 2, 4)
            If x = "IMTR" Then
                sCOMT = Split(sline, ",", 24, 1)
            ElseIf x = "INVA" Then
                sCOMT = Split(sline, ",", 22, 1)
            ElseIf x = "MORV" Then
                sCOMT = Split(sline, ",", 40, 1)
            End If
            If sCOMT(4) = """9""" Or sCOMT(4) = """0""" Then
                sCOMT(2) = Left(sCOMT(2), 11) & " " & Right(sCOMT(3), 9)
                sCOMT(3) = ""
                If sCOMT(0) = """MORV00""" Then
                    sCOMT(39) = ""
                    If sCOMT(34) = """""" Then
                        sCOMT(34) = "N"
                    End If
                ElseIf sCOMT(0) = """IMTR01""" Then
                    sCOMT(23) = ""
                ElseIf sCOMT(0) = """INVA01""" Then
                    sCOMT(21) = ""
                End If
                sline = Join(sCOMT, ",")
    
                If Mid(sline, 2, 4) = "IMTR" Then
                        N.WriteLine (sline)
                ElseIf Mid(sline, 2, 4) = "MORV" Then
                        If Mid(sline, 30, 3) <> sCrap Then
                            O.WriteLine (sline)
                        End If
                ElseIf Mid(sline, 2, 4) = "INVA" Then
                        sline = Replace(sline, ",.,", ",.0,")
                        If Mid(sline, 30, 3) <> sCrap Then
                            M.WriteLine (sline)
                        End If
                End If
            End If
        End If

        If Not P.AtEndOfStream Then
                sline = P.ReadLine
        Else
                Exit Do
        End If
        
        Loop

        P.Close
        O.Close
        N.Close
        M.Close

        Main = DTSTaskExecResult_Success

End Sub

Open in new window

0
 

Author Closing Comment

by:Delta7428
ID: 35112226
......
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question