Home |
Search |
Today's Posts |
#3
![]() |
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Excel 2003 FAILS, but Excel 2000 SUCCEEDS ??? | Excel Discussion (Misc queries) | |||
Make a text file from Excel workbook | Excel Discussion (Misc queries) | |||
Excel 2000 file when opened in Excel 2003 generates errors? | Excel Discussion (Misc queries) | |||
numbers and text in Excel to read as text keeping the leading zer. | Excel Discussion (Misc queries) | |||
Using Jet to read excel file returns blank for last cell - sometim | Excel Discussion (Misc queries) |