Help with Text import and data extraction
Try this code.The path and filename need to be changed. I not sure I got it
exactly right because the posted text file lines wrapped because they were
very long. Th ecode I think does evverything. there are 3 subroutines so
make sure you got all three.
Enum StateValues
GetProjectCode = 1
GetHeader = 2
GetData = 3
End Enum
Const StartCol = 1
Const Colwidth = 2
Sub Getbudget()
Const MyPath = "C:\temp\test"
ReadFileName = "budget.txt"
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const Header = "COMPNAME CONTRACTORS PTY LTD"
Const StartCol = 1
Const Colwidth = 2
Dim ColWidths(7, 2)
Dim Data(7)
ColWidths(1, StartCol) = 1
ColWidths(1, Colwidth) = 21
ColWidths(2, StartCol) = 22
ColWidths(2, Colwidth) = 21
ColWidths(3, StartCol) = 43
ColWidths(3, Colwidth) = 14
ColWidths(4, StartCol) = 57
ColWidths(4, Colwidth) = 23
ColWidths(5, StartCol) = 80
ColWidths(5, Colwidth) = 15
ColWidths(6, StartCol) = 95
ColWidths(6, Colwidth) = 16
ColWidths(7, StartCol) = 111
ColWidths(7, Colwidth) = 16
Set fsread = CreateObject("Scripting.FileSystemObject")
'open files
ReadPathName = MyPath & "\" & ReadFileName
Set fread = fsread.GetFile(ReadPathName)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)
RowCount = 1
ReadState = GetProjectCode
Do While tsread.atendofstream = False
InputLine = tsread.ReadLine
Select Case ReadState
Case GetProjectCode
If Left(InputLine, Len(Header)) = Header Then
ProjectCode = Trim(Mid(InputLine, Len(Header) + 1))
ProjectCode = Trim(Left(ProjectCode, _
InStr(ProjectCode, " ") - 1))
ReadState = GetHeader
End If
Case GetHeader
'look for group and beginning of line
If Left(InputLine, Len("Group")) = "Group" Then
Call GetDataField(InputLine, ColWidths, Data)
Call WriteSheet(Data, RowCount)
ReadState = GetData
End If
Case GetData
If Left(InputLine, Len(Header)) = Header Then
Exit Do
End If
Call GetDataField(InputLine, ColWidths, Data)
If Data(3) < "" Then
Data(3) = ProjectCode & "-" & Data(3)
End If
Call WriteSheet(Data, RowCount)
End Select
Loop
tsread.Close
End Sub
Sub GetDataField(InputLine, ByRef ColWidths, ByRef Data)
For DataField = 1 To 7
Data(DataField) = Trim(Mid(InputLine, _
ColWidths(DataField, StartCol), _
ColWidths(DataField, Colwidth)))
Next DataField
End Sub
Sub WriteSheet(ByRef Data, ByRef RowCount)
For ColumnCount = 1 To 7
Cells(RowCount, ColumnCount) = Data(ColumnCount)
Next ColumnCount
RowCount = RowCount + 1
End Sub
"Jim" wrote:
I forgot to mention that we want the first column of the import data to be
the Project Code ie; ColA = M102. ColB=M102-H-003-GM. ColC=Actual $.
ColD=Budget$.
"Joel" wrote:
Jim : If you post some of the test file data it would be easy to write a
macro that wil do everything you are asking.
"Jim G" wrote:
We are converting to new software and want to import project data from the
old system.
I import the text file (I think its a print file as text) and skip the
first two columns. This eliminates the group headers and leaves me with a
list of cost references that I need to concatenate with a Project Code, ie;
M102 (col A) added to H-003-GM (col B) to become "M102-H-003-GM". Cols C
has the Actual $ and Col D the Budget $. Row 13 has the project actual
revenue in Col B and budget in Col C, but has no reference in Col A, so I
would want to create a temporary one ie; "M102-REV"
Because I've skipped importing the first two group header cols from the text
file, I'm left with the page headers and group footers/totals in Col B & C.
My Questions a
1. The Project Code is not imported due to skipping the first two default
columns so I need to extract the Project Code from the text file before I do
this. Data starts at Row 3 with the words "COMPNAME CONTRACTORS PTY LTD
M102 PROJNAME". (there are 5 spaces between LTD and M102). I need the
M102 which can be more than 4 characters. The first col must be formatted to
text due to some reference codes converting to date (ie; 10-04)
Is it possible to do this and import the Fixed Width text at Col Breaks 42,
60, 78 and 94 using VBA?
2. The text file contains page headers that need to be eliminated. Each
page header is the same as rows 3 to 12. (rows 1 & 2 are blank). There is
also an "**End or Report**" that would need to be deleted.
I would then sort by Col A (now containing only project and reference and
delete any rows after the last reference. These are the group totals with
only $$$'s in col B so Col A will be blank.
The end result is a new list of just reference codes, their actual and
budget. This will be imported into the new software to start the projects
off. Unfortunately, there are dozens of projects so Id like a more
automated way of doing this.
Any help would be appreciated.
--
Jim
|