Help with Text import and data extraction

J

Jim G

We are converting to new software and want to import project data from the
old system.

I import the text file (I think it’s 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 are:

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 I’d like a more
automated way of doing this.

Any help would be appreciated.
 
J

Joel

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.
 
J

Jim

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$.
 
J

Joel

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
 
J

Joel

I had the Variance Colun rather than the budget column on previous posting.

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 Footer = "Total Overheads"

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)

'write header row
Range("A1") = "Project Code"
Range("B1") = "Cost Reference"
Range("C1") = "Actual"
Range("D1") = "Budget"

RowCount = 2
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
ReadState = GetData
End If
Case GetData
If Left(InputLine, Len(Footer)) = Footer Then
Exit Do
End If
If Left(InputLine, Len(Header)) = Header Or _
Mid(InputLine, 2, Len(Header)) = Header Then

'remove form feed
If Left(InputLine, 1) <> "C" Then
InputLine = Mid(InputLine, 2)
End If
ProjectCode = Trim(Mid(InputLine, Len(Header) + 1))
ProjectCode = Trim(Left(ProjectCode, _
InStr(ProjectCode, " ") - 1))
ReadState = GetHeader
Else
If InputLine <> "" Then
Call GetDataField(InputLine, ColWidths, Data)
Call WriteSheet(Data, RowCount, ProjectCode)
End If
End If
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, ProjectCode)

GoodData = False
If (Data(1) = "") And (Data(2) = "") And _
(Data(3) <> "") Then

GoodData = True
End If
If (Data(1) <> "") And (Data(2) = "") And _
(Data(4) <> "") And (Data(6) <> "") Then
GoodData = True
End If

If GoodData = True Then
Range("A" & RowCount) = ProjectCode
If Data(3) = "" Then
Range("B" & RowCount) = ProjectCode & "-" & Data(1)
Else
Range("B" & RowCount) = ProjectCode & "-" & Data(3)
End If
Range("C" & RowCount) = Data(4)
Range("D" & RowCount) = Data(5)

RowCount = RowCount + 1
End If
End Sub
 
J

Jim G

This is great Joel,
The only thing missed was the Total rows in col A that were picked up and
had the project code apended. EG: "M102-Total Plant General". Otherwise
it's tpot on.

There is a date on row 7 of the text file after the words "Cut off date". In
this case 31 Oct 07. How could I extract this and use it as part of the file
name along with the project number and save the file to a particular
directory? For example, C:\Project Data\Projects\Project Data M102 31 OCT
07.xls

Cheers
 
J

Joel

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 SaveDir = "C:\Project Data\Projects"
'Const SaveDir = "C:\temp\test"

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Const Header = "COMPNAME CONTRACTORS PTY LTD"
Const Footer = "Total Overheads"
Const CutoffString = "Cut-off Date"

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)

'write header row
Range("A1") = "Project Code"
Range("B1") = "Cost Reference"
Range("C1") = "Actual"
Range("D1") = "Budget"

RowCount = 2
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 cut off date
If InStr(InputLine, CutoffString) > 0 Then
CutoffDate = Mid(InputLine, _
InStr(InputLine, CutoffString) + _
Len(CutoffString))

CutoffDate = Trim(Left(CutoffDate, _
InStr(CutoffDate, "(") - 1))
End If
'look for group and beginning of line
If Left(InputLine, Len("Group")) = "Group" Then
ReadState = GetData
End If
Case GetData
If Left(InputLine, Len(Footer)) = Footer Then
Exit Do
End If
If Left(InputLine, Len(Header)) = Header Or _
Mid(InputLine, 2, Len(Header)) = Header Then

'remove form feed
If Left(InputLine, 1) <> "C" Then
InputLine = Mid(InputLine, 2)
End If
ProjectCode = Trim(Mid(InputLine, Len(Header) + 1))
ProjectCode = Trim(Left(ProjectCode, _
InStr(ProjectCode, " ") - 1))
ReadState = GetHeader
Else
If InputLine <> "" Then
Call GetDataField(InputLine, ColWidths, Data)
Call WriteSheet(Data, RowCount, ProjectCode)
End If
End If
End Select

Loop

tsread.Close
SaveFilename = SaveDir & "\Project Data " & ProjectCode & _
" " & CutoffDate & ".xls"
ThisWorkbook.SaveAs filename:=SaveFilename

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, ProjectCode)

GoodData = False
If (Data(1) = "") And (Data(2) = "") And _
(Data(3) <> "") Then

GoodData = True
End If
If (Data(3) = "") And (IsNumeric(Data(4))) Then

GoodData = True
End If

If GoodData = True Then
Range("A" & RowCount) = ProjectCode
If Data(3) = "" Then
Range("B" & RowCount) = ProjectCode & "-" & Data(1)
Else
Range("B" & RowCount) = ProjectCode & "-" & Data(3)
End If
Range("C" & RowCount) = Data(4)
If Data(5) = "" Then
Data(5) = 0
End If
Range("D" & RowCount) = Data(5)

RowCount = RowCount + 1
End If
End Sub
 
J

Jim G

Hi Joel,
The Totals sub headers are still being considered project cost references.
Here's a few sample lines:

Project Code Cost Reference Actual Budget
M102 M102-Revenue 3,799,861.32 0.00
M102 M102-L-AD-ACT 9,854.80 0.00
M102 M102-L-AD-ONC 16,250.14 0.00
M102 M102-Total Labour: Staff 26,104.94 0.00

The first line "M102-Revenue" is perfect, however, the 4th line is the total
of the two lines above it.

Otherwise, the code works well, thanks for the help.
 
J

Joel

I only change one statement

from
If (Data(3) = "") And (IsNumeric(Data(4))) Then
to
If (Left(Data(1), 5) <> "Total") And _
(Data(3) = "") And (IsNumeric(Data(4))) Then



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 SaveDir = "C:\Project Data\Projects"
Const SaveDir = "C:\temp\test"

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Const Header = "COMPNAME CONTRACTORS PTY LTD"
Const Footer = "Total Overheads"
Const CutoffString = "Cut-off Date"

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)

'write header row
Range("A1") = "Project Code"
Range("B1") = "Cost Reference"
Range("C1") = "Actual"
Range("D1") = "Budget"

RowCount = 2
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 cut off date
If InStr(InputLine, CutoffString) > 0 Then
CutoffDate = Mid(InputLine, _
InStr(InputLine, CutoffString) + _
Len(CutoffString))

CutoffDate = Trim(Left(CutoffDate, _
InStr(CutoffDate, "(") - 1))
End If
'look for group and beginning of line
If Left(InputLine, Len("Group")) = "Group" Then
ReadState = GetData
End If
Case GetData
If Left(InputLine, Len(Footer)) = Footer Then
Exit Do
End If
If Left(InputLine, Len(Header)) = Header Or _
Mid(InputLine, 2, Len(Header)) = Header Then

'remove form feed
If Left(InputLine, 1) <> "C" Then
InputLine = Mid(InputLine, 2)
End If
ProjectCode = Trim(Mid(InputLine, Len(Header) + 1))
ProjectCode = Trim(Left(ProjectCode, _
InStr(ProjectCode, " ") - 1))
ReadState = GetHeader
Else
If InputLine <> "" Then
Call GetDataField(InputLine, ColWidths, Data)
Call WriteSheet(Data, RowCount, ProjectCode)
End If
End If
End Select

Loop

tsread.Close
SaveFilename = SaveDir & "\Project Data " & ProjectCode & _
" " & CutoffDate & ".xls"
ThisWorkbook.SaveAs filename:=SaveFilename

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, ProjectCode)

GoodData = False
If (Data(1) = "") And (Data(2) = "") And _
(Data(3) <> "") Then

GoodData = True
End If
If (Left(Data(1), 5) <> "Total") And _
(Data(3) = "") And (IsNumeric(Data(4))) Then

GoodData = True
End If

If GoodData = True Then
Range("A" & RowCount) = ProjectCode
If Data(3) = "" Then
Range("B" & RowCount) = ProjectCode & "-" & Data(1)
Else
Range("B" & RowCount) = ProjectCode & "-" & Data(3)
End If
Range("C" & RowCount) = Data(4)
If Data(5) = "" Then
Data(5) = 0
End If
Range("D" & RowCount) = Data(5)

RowCount = RowCount + 1
End If
End Sub
 
J

Jim

This is excellent Joel, thanks.

The chap who will use the template to convert his projects has not yet had a
chance to test the upload, although, I've tested to the file creation stage
and it performs exactly as you planned.

I made a change to the save file area to make a copy of the original txt
file (just in case).
=================================
' to create the path and file name for the archive copy of the original text
report
CreateCopy = MyBackUp & "\ProjData " & ProjectCode & _
" " & CutoffDate & ".txt"

ActiveWorkbook.SaveCopyAs Filename:=CreateCopy

' to open a new template to proceed to the next project
OpenTemplateCSV

===================================
I was also experimenting with saving as a csv in anticipation that he may
ask for a csv fomat to upload. From re-reading some of your other posts I
was aware that it's not as simple as saving as a csv within Excel. If I open
an excel created csv file in Wordpad I get:
M102,M102-H-004-GM,"3,376.25",0.00
M102,M102-H-005-GM,(546.29),0.00
M102,M102-H-014-GM,4.30,0.00

I'm assuming the quotes are due to the number formats containing commas.

I found another post of yours that I tried to adapt but with so much Going
on I got lost. I hope you can help with this: See the next reply for my
fumbling attempt.
 
J

Jim

I found your code for creating a CSV formatted file and realised that it must
use a file that is already text. So I'm officially lost.

Const Delimiter = ","
Set fswrite = CreateObject("Scripting.FileSystemObject")
WriteFileName = "TestCSVData.txt" ' ===this was a file created from our new
data

WritePathName = MyPath + WriteFileName
fswrite.CreateTextFile WritePathName
Set fwrite = fswrite.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For RowCount = 1 To LastRow
LastCol = Cells(RowCount, Columns.Count).End(xlToLeft).Column
For ColCount = 1 To LastCol
If ColCount = 1 Then
OutputLine = Cells(RowCount, ColCount)
Else
OutputLine = OutputLine & Delimiter & Cells(RowCount, ColCount)
End If
Next ColCount
tswrite.writeline OutputLine
Next RowCount

tswrite.Close
 
J

Joel

The code you posted is dumping data from a spreadsheet to a text file. The
text file could be a .txt extension or a .csv file. CSV is just text with no
formatting. A CSV file is both a text file and an Excel file.

Some recommendations
1) Your saveas write to a spreadsheet and saves the macro in the new
workbook. Because the macro is in the workbook you will get a pop up every
time the workbook is oped indicating there is a macro (medium security
level). Most people create a new workbook and reads the text data into the
new workbook and then does a saveas so the macro doesn't end up being saved
in each workbook.

2) You can automate the code so it will perfrom the same operattions on
every file in a directory. This way you only havve to run the macro once.
The code can do a dir(*.txt) and then convert the files all at one time

3) If you want txt output you don't have to read the data into a
spreadsheet. You can open two files (one read and one writte) and then just
write the data to a new text file.
 
J

Jim G

Your advice is correct, this code:
=================================
CreateCopy = MyBackUp & "\ProjData " & ProjectCode & _
" " & CutoffDate & ".txt"

ActiveWorkbook.SaveCopyAs Filename:=CreateCopy
=================================

creates a copy that is not a replica of the original text file as planned,
and is unusable. What's the best method of doing this?


1) I noticed this during my testing so this sounds very practical.

2) From my discussions with the user, it looks like he will be running one
text report per project for each month he wants to load into his analysis
tool. This suggestions would be a great time saver.

3) I've been playing around with some of your previously posted code to
convert the excel file we've created with some success. However, when I look
at the code we are using to create this file I don't know where to start. I
assume I would need to modify:

Sub WriteSheet(ByRef Data, ByRef RowCount, ProjectCode)

GoodData = False
If (Data(1) = "") And (Data(2) = "") And _
(Data(3) <> "") Then

GoodData = True
End If
If (Left(Data(1), 5) <> "Total") And _
(Data(3) = "") And (IsNumeric(Data(4))) Then

GoodData = True
End If

If GoodData = True Then
Range("A" & RowCount) = ProjectCode
If Data(3) = "" Then
Range("B" & RowCount) = ProjectCode & "-" & Data(1)
Else
Range("B" & RowCount) = ProjectCode & "-" & Data(3)
End If
Range("C" & RowCount) = Data(4)
If Data(5) = "" Then
Data(5) = 0
End If
Range("D" & RowCount) = Data(5)

RowCount = RowCount + 1
End If


End Sub

I apologise if I sound confused. I'm not that accomplished at VBA and your
concept of working with text files outside of Excel takes a bit of getting
used to. I usually have an idea of what I want to do and then proceed to
find code, modify it and piece it together until I get a result. I'm getting
the gist of it but still a bit slow, so thanks for your patience.
 
J

Joel

Look at this modified code. It looks for all files in a directory, and it
saves the data as CSV. It doesn't put any data into the workbook

Because it doesn't know the name of the write file until the program runs
the code creates a temporary file temp.csv. It then renames the file at the
end using a move function.

Enum StateValues
GetProjectCode = 1
GetHeader = 2
GetData = 3
End Enum
Const StartCol = 1
Const Colwidth = 2
Sub Getbudget()

Const MyPath = "C:\temp\test"
'Const SaveDir = "C:\Project Data\Projects"
Const SaveDir = "C:\temp\test"

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Const Header = "COMPNAME CONTRACTORS PTY LTD"
Const Footer = "Total Overheads"
Const CutoffString = "Cut-off Date"

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 fs = CreateObject("Scripting.FileSystemObject")
First = True
Do
If First = True Then
ReadFileName = Dir(MyPath & "\*.txt")
First = False
Else
ReadFileName = Dir()
End If
If ReadFileName <> "" Then

'open files
ReadPathName = MyPath & "\" & ReadFileName
Set fread = fs.GetFile(ReadPathName)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

WritePathName = MyPath + "\temp.csv"
fs.CreateTextFile WritePathName
Set fwrite = fs.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

'write header row
tswrite.write "Project Code,"
tswrite.write "Cost Reference,"
tswrite.write "Actual,"
tswrite.writeline "Budget"

RowCount = 2
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 cut off date
If InStr(InputLine, CutoffString) > 0 Then
CutoffDate = Mid(InputLine, _
InStr(InputLine, CutoffString) + _
Len(CutoffString))

CutoffDate = Trim(Left(CutoffDate, _
InStr(CutoffDate, "(") - 1))
End If
'look for group and beginning of line
If Left(InputLine, Len("Group")) = "Group" Then
ReadState = GetData
End If
Case GetData
If Left(InputLine, Len(Footer)) = Footer Then
Exit Do
End If
If Left(InputLine, Len(Header)) = Header Or _
Mid(InputLine, 2, Len(Header)) = Header Then

'remove form feed
If Left(InputLine, 1) <> "C" Then
InputLine = Mid(InputLine, 2)
End If
ProjectCode = Trim(Mid(InputLine, Len(Header) + 1))
ProjectCode = Trim(Left(ProjectCode, _
InStr(ProjectCode, " ") - 1))
ReadState = GetHeader
Else
If InputLine <> "" Then
Call GetDataField(InputLine, ColWidths, Data)
Call WriteSheet(Data, RowCount, _
ProjectCode, tswrite)
End If
End If
End Select

Loop
tsread.Close
tswrite.Close
Savefilename = SaveDir & "\Project Data " & ProjectCode & _
" " & CutoffDate & ".csv"
fwrite.Move Savefilename
End If
Loop While ReadFileName <> ""



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, _
ProjectCode, tswrite)

GoodData = False
If (Data(1) = "") And (Data(2) = "") And _
(Data(3) <> "") Then

GoodData = True
End If
If (Left(Data(1), 5) <> "Total") And _
(Data(3) = "") And (IsNumeric(Data(4))) Then

GoodData = True
End If

If GoodData = True Then
OutputLine = ProjectCode & ","
If Data(3) = "" Then
OutputLine = OutputLine & _
ProjectCode & "-" & Data(1) & ","
Else
OutputLine = OutputLine & _
ProjectCode & "-" & Data(3) & ","
End If
OutputLine = OutputLine & Data(4) & ","
If Data(5) = "" Then
Data(5) = 0
End If
OutputLine = OutputLine & Data(5)
tswrite.writeline OutputLine
End If
End Sub
 
J

Jim G

She thousands separator was causing causing problems so I amended the
following to format without the thousand separatorin Sub Writesheet:

OutputLine = OutputLine & Format(Data(4), "####0.00") & ","
If Data(5) = "" Then
Data(5) = 0
End If

OutputLine = OutputLine & Format(Data(5), "####0.00")

I hope I've put the right thing in the right place. The results are as
needed.

I placed two files in the Temp\Test dir. When I run the code I get the csv
files and temp.csv in the test directory. When I run the code a second time
I get the error "file aleady exists". Since "MyPath" and "SaveDir" are in the
same place, how does the Move instruction make a copy? I tried to change the
paths to the following:

MyPath = "C:\ProjData\Data ==being the source text files.

SaveDir = "C:\ProData\Projects ==being the location of the converted text
files to be imported.

MyBackUp = "C:\ProjData\DataCopy ==being the location the original files are
moved to from C:\ProjData\Data. Then they won't run again or need to be
deleted in readiness for the next batch.

I made the changes but the same error message resulted even after I deleted
the files. It only seemed to work on a first run when MyPath & SaveDir were
the same.

Should change other areas of the code that writes a file?
 
J

Joel

Three things to check
1) remove all .txt files from the directory exceptt for the two files you
are using
2) make sure the project ID or date are diffferent in the two files. I
changed the date from 07 to 08 in one file so I didn't get a duplicate.
3) Make sure the csv files don't exist. delete the old ones. move will not
work if the file already exists.

I changed the move to a copy and solved this problem. The temp.csv doesn't
get removed, but who cares. I can delete the file if necessary. We can also
change the temp.csv to temp.tmp. I like this solution.

from
WritePathName = MyPath + "\temp.csv"
to
WritePathName = MyPath + "\temp.tmp"

from
fwrite.move Savefilename
to
fwrite.Copy Savefilename
 
J

Jim G

Good call and a perfect result in my test. Hopefully I get the same result
at the office tomorrow morning. It’s amazing the effect such a small change
can make.

I made the following changes to effect this:

Const MyPath = "C:\ProjData\Data"
Const SaveDir = "C:\ProjData\Projects"
Const SaveOrigDir = "C:\PROJDATA\Datacopy"

Savefilename = SaveDir & "\Project Data " & ProjectCode & _
" " & CutoffDate & ".csv"

SaveOrigFilename = SaveOrigDir & "\" & readfilename

fwrite.Copy Savefilename
fwrite.Copy SaveOrigFilename

This has written all the CSV files to the “Projects†Dir and made a copy of
the original files in the “Datacopy†Dir. Re-running the code does not return
an error. Since changes may be made to the projects after import and this
process repeated, this is just what I need.

I have some of your previous code that appends multiple data files to a
single file. This would make the import a single upload rather than one
project at a time. I don’t think the dates are an issue as it will be a
monthly process and the period set at the import side.

I’m going to have a go at changing the code in this routine. Can you tell
me the correct position to make the change or if it needs different
modification.

We trial our first import routine on Thursday. I hope you don’t mind if I
post some feedback on the result.
 
J

Joel

If you are going to have one write file for multiple read files then there
arre two thing to change.

1) The header row should be outside the big do loop
2) the opening and closing of the write files should also be outside the bi
do loop

'the start of thhe big do loop
from
Do
If First = True Then
ReadFileName = Dir(MyPath & "\*.txt")
First = False
Else
ReadFileName = Dir()
End If
If ReadFileName <> "" Then

'open files
ReadPathName = MyPath & "\" & ReadFileName
Set fread = fs.GetFile(ReadPathName)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)

WritePathName = MyPath + "\temp.csv"
fs.CreateTextFile WritePathName
Set fwrite = fs.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

'write header row
tswrite.write "Project Code,"
tswrite.write "Cost Reference,"
tswrite.write "Actual,"
tswrite.writeline "Budget"


to
WritePathName = MyPath + "\temp.csv"
fs.CreateTextFile WritePathName
Set fwrite = fs.GetFile(WritePathName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

'write header row
tswrite.write "Project Code,"
tswrite.write "Cost Reference,"
tswrite.write "Actual,"
tswrite.writeline "Budget"


Do
If First = True Then
ReadFileName = Dir(MyPath & "\*.txt")
First = False
Else
ReadFileName = Dir()
End If
If ReadFileName <> "" Then

'open files
ReadPathName = MyPath & "\" & ReadFileName
Set fread = fs.GetFile(ReadPathName)
Set tsread = fread.OpenAsTextStream(ForReading, TristateUseDefault)


also the end of the do loop
from
Loop
tsread.Close
tswrite.Close
Savefilename = SaveDir & "\Project Data " & ProjectCode & _
" " & CutoffDate & ".csv"
fwrite.Move Savefilename
End If
Loop While ReadFileName <> ""


to
Loop
tsread.Close
End If
Loop While ReadFileName <> ""

tswrite.Close
Savefilename = SaveDir & "\Project Data " & ProjectCode & _
" " & CutoffDate & ".csv"
fwrite.Move Savefilename
 
J

Jim G

Hi Joel,

This works brilliantly, we may still need to do a few mods after testing is
final. I’ve learned a lot with your help and can’t thank you enough. I wish
I knew where to send the bottle of your favourite tipple. In any case, I
hope you have a very enjoyable holiday break.


BTW: I found this little gem from Ron de Buin to solve the file moving issue.

Sub Move_Data_Files_To_New_Folder()
'This example move all Excel files from FromPath to ToPath.
'Note: It will create the folder ToPath for you with a date-time stamp
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String

FromPath = "H:\ProjData\Data" '<< Change
ToPath = "H:\ProjData\DataCopy\" & Format(Now, "yyyy-mm-dd h-mm-ss") _
& " Data Files" & "\" '<< Change only the destination folder

FileExt = "*.TXT" '<< Change
'You can use *.* for all files or *.doc for word files

If Right(FromPath, 1) <> "\" Then
FromPath = FromPath & "\"
End If

FNames = Dir(FromPath & FileExt)
If Len(FNames) = 0 Then
MsgBox "No files in " & FromPath
Exit Sub
End If

Set FSO = CreateObject("scripting.filesystemobject")

FSO.CreateFolder (ToPath)

FSO.movefile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find copies of the DATA files from " & FromPath & " in "
& ToPath

End Sub


Cheers
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

tiny discrepancies in fixed-point numbers 3
Resource Budget Cost - Tracking 0
Index/Match Lookup with a merged col 2
how to insert serial numbers to rows? 3
Embedded Excel into Word with Tables 0
Can activities be imported with their relationships? 0
numerical value to text description 1
cycle through list and put data found in col a into col d 6

Top