First, you wrote semicolon, but typed a colon (:). I'm guessing your sample is
correct.
And if you have a key value in your text file, you could use that key instead of
counting records. (Counting records is fine if there's no other way--but if
someone edits a single file and deletes/inserts a line, then the code will break
down pretty fast. I'd believe the key (as long as it's unique???).)
And since you're running this from excel, you don't need to create another
instance of excel. You can just have another workbook open in that same
instance.
And you can read a text file using "Open xxx For Input As ###" and read each
line looking for what you want.
And there's lots of ways to get the list of .txt files from a single folder. I
used a different one from yours.
If this seems to make sense, then how about this:
Option Explicit
Sub testme()
Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
'change to point at the folder to check
myPath = "c:\my documents\excel"
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
If fCtr 0 Then
Set wks = Workbooks.Add(1).Worksheets(1)
wks.Range("a1").Resize(1, 3).Value _
= Array("Property Address", "Total Value", "FileName")
For fCtr = LBound(myFiles) To UBound(myFiles)
Call DoTheWork(myPath & myFiles(fCtr), wks)
Next fCtr
wks.UsedRange.Columns.AutoFit
End If
End Sub
Sub DoTheWork(myFileName As String, wks As Worksheet)
Dim myNumber As Long
Dim myLine As String
Dim FileNum As Long
Dim oRow As Long
Dim FoundAddr As Boolean
Dim FoundTot As Boolean
Dim Str1 As String
Dim Str2 As String
Str1 = LCase("Property Address:")
Str2 = LCase("Total Value:")
With wks
oRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
FoundAddr = False
FoundTot = False
FileNum = FreeFile
Close FileNum
Open myFileName For Input As FileNum
wks.Cells(oRow, "C").Value = myFileName
Do While Not EOF(FileNum)
Line Input #FileNum, myLine
If LCase(Left(myLine, Len(Str1))) = Str1 Then
wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(Str1) + 1))
FoundAddr = True
ElseIf LCase(Left(myLine, Len(Str2))) = Str2 Then
wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(Str2) + 1))
FoundTot = True
Exit Do 'no need to contine reading the file
End If
Loop
If FoundAddr = False Then
wks.Cells(oRow, "A").Value = "**Error**"
End If
If FoundTot = False Then
wks.Cells(oRow, "B").Value = "**Error**"
End If
Close FileNum
End Sub
===
But I did depend on the order of the input not changing--address comes before
total.
Willie T wrote:
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
--
Dave Peterson
|