Link to home
Start Free TrialLog in
Avatar of Arfx3
Arfx3

asked on

Excel 2007 VBA code to look through a folder

Hi. Its a long time since I've coded, and I'm having trouble with something I'm sure is pretty easy.. I have Excel 2007 running in Win 7x64.

- I need to specify a folder on my hard drive
- This folder contains many subfolders
- Each subfolder has one .csv (comma separated file - these open in Excel on my PC) file in it. I need to open the .csv file
- (once I have control of the csv file I have already written the code for what I want to do, but it involves importing some of the data from a known cell range to one master workbook)
- I then I need to close it and move on to the next subfolder

Web searches and MS VBA Help both talk about the filesearch command, but this appears to have been disabled by MS in 2007.

I have seen what appear to be similar questions and answers looking through old EE posts - some refer to fso (file system objects), which I don't yet understand, and I can't get the code to run.

Can someone give me some example code please

Thanks
Avatar of rspahitz
rspahitz
Flag of United States of America image

I'm not quite sure what you're asking.

The FSO is one way to access file info.  However, I prefer the old way because you don't have to instantiate any objects:

 
Sub ReadCSVFiles()
    Dim iFileNumber As Integer
    Dim strFileName As String
    Dim strFileContents As String
    
    strFileName = Dir("C:\*.csv")
    Do Until strFileName = ""
       iFileNumber = FreeFile()
       Open strFileName For Binary As #iFileNumber
       strFileContents = Input(LOF(iFileNumber), iFileNumber)
       ' do something with file contents
       Close #iFileNumber
       strFileName = Dir
    Loop
End Sub

Open in new window

oops...one correction...on the Open line, you'll need the full path:

Open "C:\" & strFileName For Binary As #iFileNumber

You may want to put the path in a separate variable since you're going to use it twice.
Avatar of Arfx3
Arfx3

ASKER

Hello rspahitz, thanks for looking at my post.

I have a folder on my hard drive. Its address is
C:Users\Arf\Documents\Project\Data

The 'Data' folder contains only subfolders, i.e. .....\Project\Data\sub1   and sub2, sub3 etc.

Sub1, Sub2, Sub3 etc etc all contain a csv file I want to open. I'm going to copy cells A3:G1000, and copy them into the Workbook that I am running the code from.

When I ran your code, above, I changed your line strFileName = Dir("C:\*.csv") to

strFileName = Dir("C:Users\Arf\Documents\Project\Data\*.csv"), but it bypasses the rest of the code because it didn't find anything - in other words the code immediately decides that (Do Until strFileName = "") is true because strFileName is blank.

I can understand that - the csv files are not in the 'Data' folder, they are all still in the subfolders within the Data folder. Does that help you understand what I'm trying to do?

Thanks

Arf
Avatar of Arfx3

ASKER

oh, and just to be clear the subfolders are not called sub1 etc - they have different names every time. I was just hoping for some code that went something like;

For Each Subfolder in 'Data'Folder
-open csv file
-copy A3:G1000
-paste to my workbook
-close this csv file
Next Subfolder

so you want to basically do the same thing but navigate through each subfolder?
that requires a bit more effort because this doesn't handle recursion well.
However, if there are no sub-sub folders, then this should work, by gathering the list of folders first, then navigating through each one.

See how this works....
 
Sub ReadCSVFiles()
    Dim strRootPath As String
    Dim strFilePaths() As String
    Dim iSubFolderCount As Integer
    Dim strSubFolder As String
    Dim iFileNumber As Integer
    Dim strFileName As String
    Dim strFileContents As String
    Dim iSubFolderCntr As Integer
    
    strRootPath = "C:Users\Arf\Documents\Project\Data"
    
    ReDim strFilePaths(0)
    iSubFolderCount = 0
    strSubFolder = Dir(strRootPath & "\*.*", vbDirectory)
    Do Until strSubFolder = ""
        If strSubFolder <> "." And strSubFolder <> ".." And GetAttr(strRootPath & "\" & strSubFolder) = vbDirectory Then
            strFilePaths(iSubFolderCount) = strSubFolder
            iSubFolderCount = iSubFolderCount + 1
        ReDim Preserve strFilePaths(iSubFolderCount)
        End If
        strSubFolder = Dir
    Loop
    
    For iSubFolderCntr = 0 To iSubFolderCount - 1
        strFileName = Dir(strRootPath & "\" & strFilePaths(iSubFolderCntr) & "\*.csv")
        Do Until strFileName = ""
           iFileNumber = FreeFile()
           Open strRootPath & "\" & strFilePaths(iSubFolderCntr) & "\" & strFileName For Binary As #iFileNumber
           strFileContents = Input(LOF(iFileNumber), iFileNumber)
           ' do something with file contents
           Close #iFileNumber
           strFileName = Dir
        Loop
    Next
End Sub

Open in new window

At line 31 in the above, I guess you want to call a routine to do these steps:

-copy A3:G1000
-paste to my workbook

Something like this:

CopyCSVDataToSheet(strFileContents)

then

Private Sub CopyCSVDataToSheet(CSVData As String)
   Dim strDataRows() as String
   Dim iLineCntr as Integer
   Dim strDataLine as String

   strDataRows = Split(CSVData, vbNewLine)
   For iLineCntr = 0 to Ubound(strDataRows)
      strDataLine  = strDataRows(iLineCntr )
'...
   Next
End Sub
Avatar of Arfx3

ASKER

This is brilliant (and shoots down my original comments that it was probably a simple solution!) - it works out that there are currently 59 subfolders and has opened the first one.....and that is where I fall down.

In the code;

strDataRows = Split(CSVData, vbNewLine)
   For iLineCntr = 0 to Ubound(strDataRows)
      strDataLine  = strDataRows(iLineCntr )

...I'm not getting very far in controlling what happens next so that I can copy the data into my spreadsheet. Can you explain your thinking pls - I read the help on Split function, didn't seem to mean much to me, I'm afraid. What would I need to do to paste the data into my master spreadsheet?

thanks
Arf



Split is used to split a text string into pieces.  In this case, the entire CSV file is read in so this breaks it at vbNewline, which basically means that it splits it into lines.

From there, you'll need to extract the pieces again since they are comma-separated.  I think there's a library to do that but I haven't explored that in a long time.  The simple way is to simply take strDataLine and split it again on "," (rather than vbNewLine) except that if there are any values that contain commas, this will be wrong.  so you really need to split on qualifiers first (usually quotes) then within each piece, split on commas, then put the items into an array for easy access.

Another possibility is to push everything into the clipboard then try to paste it into Excel...not sure if that would work but it seems that it should.

so for that, you could try this:



Sub CopyCSVDataToSheet(CSVData As String)
    Dim objDataObject As DataObject
    
    Set objDataObject = New DataObject
    objDataObject.SetText CSVData
    objDataObject.PutInClipboard
    Range("A1").Paste
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of rspahitz
rspahitz
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Arfx3

ASKER

It doesn't seem to like the Dim statement. I'll give this some thought, but I have meetings now, so haven't had time to think it through - just thought I'd mention it in case the reason is obvious to you.

thanks for the help so far.

Arf
you probably tried it while I was fixing it in the next post (above yours.)
Avatar of Arfx3

ASKER

Yup, guess I did :-)

Thanks for all your help - I have it working now. I'm now off to learn the joys of working with spreadsheets with 800,000 rows... I see linking to Access in my near future!!!
Avatar of Arfx3

ASKER

You need to look at the whole thread to see the solution - this reply fixed the last step of the problem but you need code from earlier posts for a complete answer.

Many thanks rspahitz