Read Text File into Excel Using VBA

Ok, I have a Routine that will read a user defined folder via an
InputBox and get a list of all the files in that folder.

Next I pass that info to a Routine that Reads the Full Text files into
individual Excel spreadsheets, so I've made some progress.

My problems let to resolve:
1. I want to read into one single spreadsheet not 25 (i.e. 25 text
files)
2. I want 1 header line in the one spreadsheet
3. I want only select info out of each text file.

Can I read the 11th line in each of the text file and import ONLY the
text behind the semicolon?
For example, the 11th line in each file is as follows:
Property Address:209 MAIN ST
I only want to import "209 MAIN ST" from the 11th line in each text
file and place the first entry in A2 of the Excel Spreadsheet, then
read the next file and place that Property Address in Cell A3 until all
text files are read.

Can anyone help or direct me to a group that can.

Code is listed below. Keep in mind since the code is snippets, it
still need some clean up.

Thanks in advance.

Willie T

Dim MyFileSystemObject As Object 'fs
Dim MyFolderObject As Object 'f
Dim MyFileObject As Object 'f1
Dim MyFileCollection As Object 'fc
Sub LoopThroughInputFiles()
Dim RoutineStartSecondCount As Long
Dim ThisFileFinishSecondCount As Long
Dim AverageSecondsPerFile As Long
Dim StringToDebugPrint As String

RoutineStartSecondCount = Int(Timer) 'int of seconds elapsed since
midnight

FolderContainingRawFiles = InputBox("Enter Name, c/w Path, of Folder
Containing Raw Files")

FileCounter = 0 'initialise

'Dim MyFileSystemObject As Object 'fs
'Dim MyFolderObject As Object 'f
'Dim MyFileObject As Object 'f1
'Dim MyFileCollection As Object 'fc

Set MyFileSystemObject = CreateObject("Scripting.FileSystemObject")
'MyFileSystemObject is a filesystemobject
Set MyFolderObject =
MyFileSystemObject.GetFolder(FolderContainingRawFiles) 'MyFolderObject
is the folder object

Set MyFileCollection = MyFolderObject.Files 'fc is the collection of
file objects in folder object f

For Each MyFileObject In MyFileCollection
FileToWorkWith = MyFileObject.Name
'Now call function/sub to work with file...
'FunctionToOpenAndWorkWithFile
ReadFullTextFile


FileCounter = FileCounter + 1
ThisFileFinishSecondCount = Int(Timer)
AverageSecondsPerFile = (ThisFileFinishSecondCount -
RoutineStartSecondCount) / FileCounter
StringToDebugPrint = FileCounter & " files (of about "
StringToDebugPrint = StringToDebugPrint &
MyFileCollection.Count
StringToDebugPrint = StringToDebugPrint & ") done so far;
time remaining "
StringToDebugPrint = StringToDebugPrint &
Format((AverageSecondsPerFile * (MyFileCollection.Count - FileCounter)
/ 60), "0.0")
StringToDebugPrint = StringToDebugPrint & " minutes"
StringToDebugPrint = StringToDebugPrint & " (average " &
Int(AverageSecondsPerFile)
StringToDebugPrint = StringToDebugPrint & " seconds/file)"
Debug.Print StringToDebugPrint

Next
Debug.Print "File Addition Finished (at last!) " & Date & ", " &
Time
End Sub


Sub ReadFullTextFile()

Dim oExcel As Object
Dim oBook As Object
Dim osheet As Object

Dim filename As String

Set oExcel = CreateObject("Excel.Application")

' Open text file
'filename = "c:\MAIN-ST-205.txt"
'Set oBook = oExcel.Workbooks.Open(filename)
Set oBook = oExcel.Workbooks.Open(MyFileObject)
Set oBook = oExcel.ActiveWorkbook

oBook.Sheets(1).Activate
Set osheet = oBook.Sheets(1)

'Set osheet = oBook.ActiveSheet
' Make Excel visible
oExcel.Visible = True
oExcel.UserControl = True

' save as excel workbook
'filename2 = "c:\MAIN-ST-205.xls"
filename2 = (MyFileObject) & ".xls"
oBook.SaveAs filename2, 1

' ***** At this point I would like to run a macro, however they are
'not available in the macro window or within this code.
Set oExcel = Nothing
Set oBook = Nothing

'End
End Sub

"Willie T" wrote...
Wow! Anyway, I had the same type need as you and have the following to get
data from given text files converted into an Excel sheet in my current
workbook. (Use full screen width to make sure lines are right.) My
variables are in [brackets], you'll just have to look at how they're used
and adjust them to your situation. First have your Sub clear your [output
sheet], put in the column headers, select cell A2, and then loop through
your files.


'get the text file to work with
filetoget = [path text] + [file name] + ".txt"
Workbooks.OpenText FileName:= _
filetoget, Origin:=xlMSDOS, StartRow:=1, _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
ActiveSheet.Move After:=Workbooks([current workbook name]).Sheets([output
sheet name])
ActiveSheet.Name = "Input"


That section puts each individual line of the chosen text file into a cell
in column A on a new sheet named "Input" in your current workbook. Now you
can select your "Input" sheet and process the two pieces of info.

fulltext = Range("A11").Text + Space(99)
proploc = Trim( Mid( fulltext, Application.Search(":", fulltext) + 1 , 99) )
fulltext = Range("A31").Text + Space(99)
propval = Val( Trim( Mid( fulltext, Application.Search(":", fulltext) + 1,
99 ) ) )


If your text file is consistently formatted, you can just use a character
position for the second parameter of each of those instead of searching for
the colon. Either way, you now have your two values in the variables
"proploc" and "propval". And it's time to get rid of your input sheet so
you can run through the same loop again with the next text file.


'get rid of the old Input sheet
Sheets("Input").Select
Application.DisplayAlerts = False 'turns off confirmation box
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True



Now you just select your output sheet, write your two variables to the
current row's cells, move your selection down a cell, and loop back to the
next text file. Let me know if any of this doesn't make sense.

Don,

Thanks a million. again, Im new at programming but I ran your code and
was able to step thru it line by line to see how it works and all work
rather well. But i'm still lacking some basic programming knowledge.
I have some code that i added to your code to get the folder and a list
of files in the working folder into an array and that code works well,
but i dont know how to feed my code into a loop and get it to work with
your. I know this is basic, but Im lacking. Below is a listing of
both yours and mine. Can you help? Thanks in advance for any help.

Sub test2()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim defaultproject As String
Dim ProjectName As String

'get the text file to work with

'change to point at the folder to check
myPath = "c:\test"
myPath = InputBox("Enter Path of Folder Containing Text Files",
"Text Files Folder:", myPath)

defaultproject = "2005 Brookside Project"
ProjectName = InputBox("Enter Project Name", "Project Name:",
defaultproject)

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

myFile = Dir(myPath & "*.txt")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop




'PathText = "c:\test\"
'filename1 = "MAIN ST 205"
'filetoget = [myPath] + [myFiles(fCtr)] + ".txt"

Workbooks.OpenText filename:= _
myFiles(fCtr), Origin:=xlMSDOS, StartRow:=1, _
DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)

ActiveSheet.Move After:=Workbooks([filename1] +
".txt").Sheets([filename1])
ActiveSheet.Name = "Input"

'That section puts each individual line of the chosen text file into a
cell
'in column A on a new sheet named "Input" in your current workbook. Now
you
'can select your "Input" sheet and process the two pieces of info.

fulltext = Range("A14").Text + Space(99)
proploc = Trim(Mid(fulltext, Application.Search(":", fulltext) + 1,
99))
fulltext = Range("A34").Text + Space(99)
propval = Val(Trim(Mid(fulltext, Application.Search(":", fulltext) + 1,
99)))

'If your text file is consistently formatted, you can just use a
character
'position for the second parameter of each of those instead of
searching for
'the colon. Either way, you now have your two values in the variables
'"proploc" and "propval". And it's time to get rid of your input sheet
so
'you can run through the same loop again with the next text file.

'get rid of the old Input sheet
Sheets("Input").Select
Application.DisplayAlerts = False 'turns off confirmation box
'ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

'Now you just select your output sheet, write your two variables to the
'current Row 's cells, move your selection down a cell, and loop back
to the
'next text file. Let me know if any of this doesn't make sense.
End Sub

"Willie T" wrote...

> but i dont know how to feed my code into a loop and get it to work

Right after the loop section where you've loaded your file names into your
array, get the number of files you have (I think a statement right after
"Loop" that reads "numFiles = fCtr - 1" would do the trick).

Right before the "Workbooks.Open ..." section, add a line that says "For
fCtr = 1 to numFiles", which will begin the loop through each filename in
your array.

At the end, after you've written out another row on your output page and
moved down to the next row, add the line "Next fCtr" to mark the end of your
loop for each text file.