looping, Open text file, copy text, close text file

**jwilds1** · 09-18-2009, 08:51 AM

Need some assistance. I have an existing spreadsheet with a column of strings (actually VIN numbers). These numbers correllate to a bunch of text files, that can exist in one of three folders (\Username\Desktop\1, 2, or 3) on my desktop. What I need the macro to do is:

1) get the filename from A2 (A1 is a heading row)
2) Find the appropriate text file in one of the three folders
3) Put the folder name into I2
4) Scan the text file for some strings, and copy some data that follows those strings into J2:O2 (I can handle programming this)
5) Close the text file
6) repeat above for the remainder of filenames (about 1800 files)

Any assistance you can offer would be great

**pike** · 09-18-2009, 09:24 AM

hi jwilds1
this is untested but try this in a test workbook

Option Explicit
Sub ptest()
 Dim i As Range, ws1 As Worksheet, e, z
 Set ws1 = Sheets("Sheet1")
 i = Range(ws1.Range("A2"), ws1.Range("A" & Rows.Count).End(xlUp))
 For Each z In i
    For Each e In Array(PathOne, PathTwo, PathThree)
           a = e & z
              If FileExists(a) Then
                   z.Offset(, 8) = e
                End If
       Next
    Next
End Sub
Function FileExists(strFile$) As Boolean
    Dim fs As Object
     Set fs = CreateObject("Scripting.FileSystemObject")
      If fs.FileExists(strFile) Then
        FileExists = True
    Else
        FileExists = False
    End If
End Function

**jwilds1** · 09-18-2009, 11:05 AM

Through a little trial and error I got the following to work:

Sub getaccdata()
Dim rng, mach As Integer
Dim file, fname, src As String
Dim i As Integer
Dim a220, a003, blah, a229, a22a As String


Dim dir As String
Dim wbk As String

Application.DisplayAlerts = False
wbk = ActiveWorkbook.Name

rng = Range("a2:a" & Range("a2").End(xlDown).Row).Rows.Count + 1

'begin looping through file names
For i = 2 To rng
    file = Cells(i, 1).Value
    Cells(i, 1).Select
    src = file & "_acc.txt"
'begin looping through directories
    
    mach = 1
    dir = "C:\Documents and Settings\jwilds1\Desktop\acc data\" & mach & "\"
    fname = dir & file & "_acc.txt"
    If fileexists(fname) Then
        Workbooks.OpenText Filename:=fname, origin:=xlWindows
        
        Else
        mach = 2
        dir = "C:\Documents and Settings\jwilds1\Desktop\acc data\" & mach & "\"
        fname = dir & file & "_acc.txt"
        If fileexists(fname) Then
        Workbooks.OpenText Filename:=fname, origin:=xlWindows
        
        Else
        mach = 3
        dir = "C:\Documents and Settings\jwilds1\Desktop\acc data\" & mach & "\"
        fname = dir & file & "_acc.txt"
        Workbooks.OpenText Filename:=fname, origin:=xlWindows
        End If
        End If
        
    'insert copy & paste
    Workbooks(wbk).ActiveSheet.Cells(i, 9).Value = mach
    Workbooks(wbk).ActiveSheet.Cells(i, 10).Value = Cells(1, 1).Value
    Cells.Find(What:="ACC Overall", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
    
    a220 = ActiveCell.Offset(1, 0).Value
    a003 = ActiveCell.Offset(2, 0).Value
    blah = ActiveCell.Offset(3, 0).Value
    a229 = ActiveCell.Offset(4, 0).Value
    a22a = ActiveCell.Offset(5, 0).Value
    
    Workbooks(wbk).ActiveSheet.Cells(i, 11).Value = a220
    Workbooks(wbk).ActiveSheet.Cells(i, 12).Value = a003
    Workbooks(wbk).ActiveSheet.Cells(i, 13).Value = blah
    Workbooks(wbk).ActiveSheet.Cells(i, 14).Value = a229
    Workbooks(wbk).ActiveSheet.Cells(i, 15).Value = a22a
    
    Workbooks(src).Close savechanges:=False
    mach = 1
Next i

Application.DisplayAlerts = True

End Sub
Public Function fileexists(fullfilename) As Boolean
fileexists = (dir(fullfilename) > "")
End Function

It's unelegant (is that a word?), but it works. Thanks!!!