Pulling data from multiple text files (and folders)

[tripkebab]

Hi Guys,

First post so hello!

I have been googling and searching forums for a while and havent found a working solution to my problem.

After reading a few threads here I understand you get frustrated with posts just asking for help and not actually including enough detail to provide a sutable awnser so I will try to give as much detail as possible.

I have come across another thread here where there is code posted to read multiple text files in VBA and import specific data to an excel spreadsheet. I have managed to use this code to get the results I desire, however unfortunatly the files I need to extract are also in multiple folders (all under a specific subfolder however).

I'm using the following code..

Sub read_text() 
     
     'Set wb = Workbooks.Add
    workingflnm = ActiveWorkbook.Name 
    i = 5 'First row in Active Sheet
    Set fd = CreateObject("Scripting.Filesystemobject") 
    pthnm = "[URL="file://gbdb1012/spparchive/SPP/110822/PRINT"]\\gbdb1012\spparchive\SPP\110822\PRINT[/URL]" 'Please change to your desired folder
    Set fs = fd.GetFolder(pthnm) 
    For Each fl In fs.Files 
         
         
        If InStr(1, fl.Name, "eodlog.spp", vbTextCompare) > 0 Then 
             
            Set Txtobj = CreateObject("Scripting.filesystemobject") 
            Set Txtfl = Txtobj.getfile(fl) 
            Set Txtstrm = Txtfl.openastextstream(1, -2) 
            Do While Txtstrm.AtEndOfStream <> True 
                rdln = Txtstrm.readline 
                 
                 
                If InStr(1, rdln, "rfsruc", vbTextCompare) > 1 Then 
                    x1 = InStr(1, rdln, "^", vbTextCompare) 
                    x2 = InStr(1, rdln, "^GBVC110007^", vbTextCompare) 
                    Workbooks(workingflnm).Sheets("Log File Extract").Cells(i, 1) = fl.Name 
                     'Construction of Ohms String
                    strg = Mid(rdln, x1 + Len("^"), x2 + Len("") - (x1 + Len("^"))) 'The String picks the character Ohms in the Line as well
                    Workbooks(workingflnm).Sheets("Log File Extract").Cells(i, 2) = strg 
                    i = i + 1 
                End If 
            Loop 
        End If 
         
    Next 
     
End Sub

This code will pull the data I require from the specified text file in \\gbdb1012\spparchive\SPP\110822\PRINT\

The folder stucture is as follows.

Root Folder
\\gbdb1012\spparchive\SPP\

Every Day a new folder is created in a YYMMDD format
\\gbdb1012\spparchive\SPP\110822\

Within this daily folder is another folder called print, in here is the file i need to pull data from
\\gbdb1012\spparchive\SPP\110822\PRINT


I need to be able to scan for text files in all the sub folders, i.e.

\\gbdb1012\spparchive\SPP\110821\PRINT
\\gbdb1012\spparchive\SPP\110822\PRINT
\\gbdb1012\spparchive\SPP\110823\PRINT
\\gbdb1012\spparchive\SPP\110824\PRINT
\\gbdb1012\spparchive\SPP\110825\PRINT
\\gbdb1012\spparchive\SPP\110826\PRINT
\\gbdb1012\spparchive\SPP\110827\PRINT

Obviously this is dynamic and ever changing so I imagine I will need some kind of loop to go though all the folders in the root folder one by one till it reaches the end?

Any suggestions on how I can alter the code to acomplish this?

Many thanks,


Please note this has been cross posted at...
http://www.ozgrid.com/forum/showthread.php?t=157461&p=572826#post572826

 

[Comfy]

By the way

Call ListFilesInFolder(file, True, 2)

You can change that number to anything you like.

It tells the code at which row you would like to start inputting the filenames.

 

[tripkebab]

Hi,

Tired addding that +1 in and it didnt fix things, it only worked when adding in the +1 to the sections below.

[B]Dim Curr_Row As Long
    If Workbooks(workingflnm).Sheets("test").Range("A65536").End(xlUp).Row > RowStart Then
        Curr_Row = Workbooks(workingflnm).Sheets("test").Range("A65536").End(xlUp).Row[/B]
 
    Else
        Curr_Row = RowStart +1   worked after putting +1 here
    End If

So the code I bolded isnt working and I could actually strip out I guess. So long as I dont mind overwriting every run.

Also I tell it to start at row 2 and it starts at row 5. Start at row 5 and it starts at row 7.

But it works so im happy!

One very last question I have is how do I use wildcards in VBA?


For example...

If InStr(1, FileItem.Name, "file21112012.spp", vbTextCompare)


If InStr(1, FileItem.Name, "file*.spp", vbTextCompare)

I want to search file(anytext).spp

 

[Comfy]

Instead of

If InStr(1, FileItem.Name, "file21112012.spp", vbTextCompare)

You could try

If FileItem.Name Like "file*.spp" Then

 

[Comfy]

I can't figure out why the code doesn't entirley work for you.

I have master folder and one subfolder.

In each folder are 3 files each file contains random text and some lines that read

ag ^ a Updt_Xfrs_Conv has completed successfully ^GBVC11

The macro returns the right number of file names, and none are over-written.

This will bug me. Can you give me an insight into the folder structure and/or how the text appears in a file?

 

[tripkebab]

Heya,

Well dont bug yourself too much, as it is working for my needs.

The folder stucture is as follows.

\\gbdb1012\spparchive\spp
--------------------110824
--------------------110823
--------------------110822.. etc

\\gbdb1012\spparchive\spp\110824\
--------------------fodler1
--------------------folder2
--------------------folder3
--------------------folder4 - file i read is in folder 4.

There will be a few hundred lines of text in each file, im just pulling data from part of one line. Each line begins with the date and time.

 

[lodey]

Hey there,

I was looking at the code and its exactly what I needed but I have ran into a slight issue:

When I run the code (after editing it to my needs) I get the a compile error stating that I have the wrong number of arguments:

It bombs out at the following line:

ListFilesInFolder SubFolder.Path, True, Curr_Row

Here is the code that I have:

Sub read_text()
Dim file As String
file = "C:\Users\ME\Documents\Rec_Drive\rec\"
Call ListFilesInFolder(file, True)
End Sub
Function ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.file
Dim Curr_Row As Long
    Curr_Row = Workbooks(workingflnm).Sheets("PART").Range("A65536").End(xlUp).Row + 1
    workingflnm = ActiveWorkbook.Name
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    For Each FileItem In SourceFolder.Files
        If InStr(1, FileItem.Name, "xml", vbTextCompare) > 0 Then
 
            Set Txtfl = FSO.getfile(FileItem)
            Set Txtstrm = Txtfl.openastextstream(1, -2)
            Do While Txtstrm.AtEndOfStream <> True
                rdln = Txtstrm.readline
 
 
                If InStr(1, rdln, "<Part>", vbTextCompare) > 1 Then
                    x1 = InStr(1, rdln, "<Part>", vbTextCompare)
                    Workbooks(workingflnm).Sheets("PART").Cells(i, 1) = fl.Name
                    strg = Mid(rdln, x1 + Len("<Part>"))
                    Workbooks(workingflnm).Sheets("PART").Cells(i, 2) = strg
                    i = i + 1
                End If
 
            Loop
        End If
 
    Next FileItem
  If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True, Curr_Row
        Next SubFolder
    End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Function

Any clue as to what could be happening?

 

[Comfy]

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True, Curr_Row
Next SubFolder
End If

to

If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If