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 left to resolve:
1. I want to read into one single spreadsheet not 25 (i.e. 25 text
files into a single spreadsheet)
2. I want 1 header line in the one spreadsheet
3. I want only select info out of each text file not the entire 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 that 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(FolderContainingRawFi les) '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
|