Draez68...It's not really that interesting
And it would not have been much different to what you
posted on here already so I emailed it to his profile
address in case he could use it. You see when I finished
writing it, you had already posted your help so I just
emailed it instead (so as not to let the work go to waste
you know).
kiwi can post it up here if he uses it...otherwise it
really won't help anyone else at all I think :)
Cheers
Alright...You asked for it
Here is the post. The whole form file is included in case you wish to see the controls on my form.
Code:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 2310
ClientLeft = 60
ClientTop = 345
ClientWidth = 6075
LinkTopic = "Form1"
ScaleHeight = 2310
ScaleWidth = 6075
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtOutputFile
Height = 285
Left = 1920
TabIndex = 2
Text = "d:\!dev\VB-World\Kiwi\output.txt"
Top = 840
Width = 3855
End
Begin VB.CommandButton cmdParse
Caption = "Just Do It"
Height = 375
Left = 1920
TabIndex = 1
Top = 1440
Width = 2175
End
Begin VB.TextBox txtInputFile
Height = 285
Left = 1920
TabIndex = 0
Text = "d:\!dev\VB-World\kiwi\input.txt"
Top = 240
Width = 3855
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "Source Data:"
Height = 255
Left = 240
TabIndex = 4
Top = 240
Width = 1575
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Output To:"
Height = 255
Left = 240
TabIndex = 3
Top = 840
Width = 1575
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Enum DataTypes
AB = 1
BA = 2
End Enum
Private Enum DataPeriod
p6 = 1
p12 = 2
p18 = 3
p24 = 4
End Enum
Private Type SummaryRecord
mCount(DataPeriod.p6 To DataPeriod.p24, 1 To 13, 1 To 2) As Integer
End Type
Private Type Summary
mDate As Date
m6 As SummaryRecord
m12 As SummaryRecord
m18 As SummaryRecord
m24 As SummaryRecord
End Type
Private mySummary() As Summary
Private nSummary As Integer 'count
Private myIndex As Collection
Private mFilename As String
Private Sub cmdParse_Click()
ParseFile txtInputFile, txtOutputFile
End Sub
Private Sub ParseFile(inputFile As String, outputFile As String)
Set myIndex = New Collection
nSummary = 0
mFilename = inputFile
Dim hInput As Long, hOutput As Long
Dim tmp As String
Dim tmpData() As String
hInput = FreeFile
Open inputFile For Input As #hInput
While Not EOF(hInput)
Line Input #hInput, tmp
If tmp <> "" Then
tmpData = Split(tmp, " ")
AddToSummary tmpData
End If
Wend
Close #hInput
If outputFile <> "" Then
hOutput = FreeFile
Open outputFile For Output As #hOutput
OutputSummary hOutput
Close #hOutput
End If
End Sub
Private Sub AddToSummary(tmpData() As String)
Dim thisIndex As Integer
Dim myTime As Date, myDate As Date
Dim myType As Integer
Dim myID As Integer
Dim msg As String
Dim c As Integer
' clear any previous errors
Err.Clear
On Error Resume Next
'parse the date/time
myTime = CDate(tmpData(0))
myDate = CDate(tmpData(1))
Select Case tmpData(2)
Case "AB"
myType = DataTypes.AB
Case "BA"
myType = DataTypes.BA
End Select
myID = CInt(tmpData(3))
If Err <> 0 Then
msg = "Could not parse data: "
For c = 0 To UBound(tmpData)
msg = msg & vbCrLf & tmpData(c)
Next
ReportError msg
End If
' look for this date in the summary collection
thisIndex = myIndex(CStr(myDate))
If Err <> 0 Then
' not found - so create one
Err.Clear
nSummary = nSummary + 1
thisIndex = nSummary - 1
ReDim Preserve mySummary(thisIndex)
mySummary(thisIndex).mDate = myDate + myTime
myIndex.Add thisIndex, CStr(myDate)
End If
' now figure out the time period
With mySummary(thisIndex)
Select Case myTime
Case Is < TimeSerial(7, 0, 0)
.m6.mCount(DataPeriod.p6, myID, myType) = .m6.mCount(DataPeriod.p6, myID, myType) + 1
Case Is < TimeSerial(13, 0, 0)
.m12.mCount(DataPeriod.p12, myID, myType) = .m12.mCount(DataPeriod.p12, myID, myType) + 1
Case Is < TimeSerial(19, 0, 0)
.m18.mCount(DataPeriod.p18, myID, myType) = .m18.mCount(DataPeriod.p18, myID, myType) + 1
Case Else
.m24.mCount(DataPeriod.p24, myID, myType) = .m24.mCount(DataPeriod.p24, myID, myType) + 1
End Select
End With
On Error GoTo 0
End Sub
Private Sub OutputSummary(hfile As Long)
Dim c As Integer
For c = 1 To nSummary
OutputSummaryRecord hfile, c
Next
End Sub
Private Sub OutputSummaryRecord(hfile As Long, index As Integer)
Dim c As Integer, d As Integer
With mySummary(index - 1)
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "6,AB,";
For c = 1 To 13
Print #hfile, .m6.mCount(DataPeriod.p6, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "6,BA,";
For c = 1 To 13
Print #hfile, .m6.mCount(DataPeriod.p6, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "12,AB,";
For c = 1 To 13
Print #hfile, .m12.mCount(DataPeriod.p12, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "12,BA,";
For c = 1 To 13
Print #hfile, .m12.mCount(DataPeriod.p12, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "18,AB";
For c = 1 To 13
Print #hfile, .m18.mCount(DataPeriod.p18, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "18,BA,";
For c = 1 To 13
Print #hfile, .m18.mCount(DataPeriod.p18, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "24,AB";
For c = 1 To 13
Print #hfile, .m24.mCount(DataPeriod.p24, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "24,BA,";
For c = 1 To 13
Print #hfile, .m24.mCount(DataPeriod.p24, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "6,AB,";
For c = 1 To 13
Print #hfile, .m6.mCount(DataPeriod.p6, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
Print #hfile, mFilename & "," & DateValue(.mDate) & "," & "6,BA,";
For c = 1 To 13
Print #hfile, .m6.mCount(DataPeriod.p6, c, 1);
If c = 13 Then Print #hfile, Else Print #hfile, ",";
Next
End With
End Sub
Private Sub ReportError(msg As String)
MsgBox msg, vbApplicationModal Or vbCritical Or vbOKOnly, "Error"
End
End Sub
Cheers
haha. What do you think I was trying to say?
Draez68, that's more or less along the lines of what I was saying. I only did the whole solution because in his profile (and the nickname) it appears he is a New Zealander like me :)
So, no apologies for posting an ugly undocumented piece of code because like I said before...YOU asked for it :) haha
If I was doing it over, I would use ADO instead. ADO can treat text files as database tables. Then it would be a matter of moving through a recordset like "normal" and writing out to another table. If I do that solution (for fun) I'll be sure to document it well for ya and post it too :)
Cheers
You're not going to believe how easy it is with ADO
I still can't get over how nice it is to treat the text file as "just a datasource" which after all is all it is.
Here's what to do:
drop this file (called schema.ini) into your data directory. This is where your source data is kept. My source data was called input.txt.
Code:
[input.txt]
ColNameHeader=False
Format=FixedLength
MaxScanRows=25
CharacterSet=ANSI
Col1=MTIME Char Width 9
Col2=MDATE Char Width 9
Col3=MTYPE Char Width 3
Col4=MVAL Char Width 3
This file describes to ADO how to read the input.txt file.
Now, on a form, make sure you select Microsoft ActiveX Data Objects Library 2.x. Mine is 2.1 at present.
Now, drop this code on a new form (Mine is called form1) Add a button to the form. You will have to modify the connection string to reflect the actual path to your data files (do NOT put the file name in there though)
Code:
Option Explicit
Dim myRs As ADODB.Recordset
Dim myConn As ADODB.Connection
Private Sub Command1_Click()
Set myRs = New ADODB.Recordset
With myRs
.Open "Select * from input.txt where [MVAL]='13'", myConn, adOpenStatic, adLockReadOnly
.MoveFirst
While Not .EOF
Debug.Print .Fields(3).Name, .Fields(0), .Fields(1), .Fields(2), .Fields(3)
.MoveNext
Wend
End With
End Sub
Private Sub Form_Load()
Set myConn = New ADODB.Connection
myConn.Open "DefaultDir=D:\!dev\VB-World\Kiwi;Driver={Microsoft Text Driver (*.txt; *.csv)};DriverId=27;Extensions=asc,csv,tab,txt;FIL=text;MaxBufferSize=2048;MaxScanRows=25;PageTimeout=5;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"
End Sub
That's IT. I mean, the code will run a standard SQL query on the "table" which is known by it's file name and return results.
In my data file, there is only one line where MVAL = 13 and guess what? I only get one row returned.
I know this is a short post (for me I mean) but I wanted you to see how easy it was to manipulate text files with ADO. I think it rocks!
Cheers
