Wrox Programmer Forums
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Old February 1st, 2011, 09:13 AM
Friend of Wrox
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts
Default VBA Loops


Does anyone know whether it is possible to create a loop that loops through files in one folder but only files that appear in list in a cell range?


Old February 2nd, 2011, 12:03 PM
Friend of Wrox
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts

sure. you have to set up that class module like i showed you before. Go to Tools > References and check "microsoft scripting runtime", then hit Insert > Class Module and name it clsFileHandler. Then paste this code into it.
'To use this class module in another workbook, you'll need to set a reference to the "microsoft scripting runtime" library
Option Explicit

Private FSO As Scripting.FileSystemObject
Private oMainFolder As Scripting.Folder
Private oFileCollection As Scripting.Files
Private oFile As Scripting.File

'For putting the file list into a worksheet
Private rgTarget As Range
Private lRangeRow As Long
Private lTargetOffset As Long

Public Sub GetAllFiles(FolderPath As String, Target As Range)
'gets all files in FolderPath, including those in subfolders
    Static oParentFolder As Scripting.Folder
    Static oSubFolder As Scripting.Folder
    Static oFolders As Scripting.Folders
    Set oParentFolder = FSO.GetFolder(FolderPath)
    Set oFolders = oParentFolder.SubFolders
    GetFileList FolderPath, Target
    If oFolders.Count = 0 Then 'there's no subfolders in this folder
        Exit Sub
    End If
    For Each oSubFolder In oFolders
        GetFileList oSubFolder.Path, Target
        GetAllFiles oSubFolder.Path, Target
End Sub
Public Sub ClearPreviousSearch(shtSheet As Worksheet)
lTargetOffset = 0
End Sub
Public Sub GetFileList(FolderToSearch As String, Target As Range)
'this will put a list of files on a spreadsheet at the Target, does not include files in subfolders

'Put a trailing backslash on path if it's not there
If Right(FolderToSearch, 1) <> "\" Then
    FolderToSearch = FolderToSearch & "\"
End If

Set rgTarget = Target

Set oMainFolder = FSO.GetFolder(FolderToSearch)
Set oFileCollection = oMainFolder.Files
lRangeRow = Target.Row

For Each oFile In oFileCollection
    If Not InStr(CStr(oFile.Name), "b") Then
        Target.Offset(lTargetOffset, 0) = oFile.Path
        Target.Offset(lTargetOffset, 1) = oFile.Name
        lTargetOffset = lTargetOffset + 1
    End If
Next oFile

End Sub

Private Sub Class_Initialize()
Set FSO = New Scripting.FileSystemObject
End Sub

Private Sub Class_Terminate()
Set FSO = Nothing
End Sub
then in your regular code Module put this in the declarations:
Dim FH As New clsFileHandler
we'll have to switch the code around some to get it to do what you want, so lemme know when you're online
Old February 3rd, 2011, 07:48 AM
Friend of Wrox
Join Date: Jan 2011
Posts: 103
Thanks: 7
Thanked 0 Times in 0 Posts


Since i posted the thread i found a bit of code online which i altered to suit my purpose and it seems to work.

BUT it keeps falling over when it comes to a file on the list which is not in the folder. I tried adding an IF statement to say if the file is not in the folder skip it and go to the next one on the list but now it seems to be skipping all the files and not returning any results

Sub Macro2()

Dim StrFldr As String
Dim ExtractCSV As Workbook
Dim ExtractCSVSheet As Worksheet
Dim lngWriteCol As Long
Dim Template As Workbook
Dim TemplateExtract As Worksheet
Dim LastRow As Long
Dim FromRow As Long
Dim FromFileName As String
Dim ToRow As Long
Dim TemplateList As Worksheet

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set Template = Application.Workbooks.Open("C:\Documents and Settings\SeymourJ\Desktop\Tasks\HondaExtractMacro\DealerData_Extract_Feed_Template.xls")
Set TemplateExtract = Template.Sheets("ExtractData")
Set TemplateList = Template.Sheets("Sheet1")

StrFldr = "C:\Documents and Settings\SeymourJ\Desktop\Test1\"

LastRow = TemplateList.Cells(Rows.Count, "C").End(xlUp).Row

lngWriteCol = 2

For FromRow = 1 To LastRow
    FromFileName = StrFldr & TemplateList.Cells(FromRow, "C").Value
    If Dir(FromFileName) > "" Then
    Set ExtractCSV = Workbooks.Open(FromFileName)
    Set ExtractCSVSheet = ExtractCSV.Worksheets(1)

    ExtractCSVSheet.Range("E2:E2000").Copy Destination:=TemplateExtract.Cells(3, lngWriteCol)
    lngWriteCol = lngWriteCol + 1
    End If

End Sub
Old February 4th, 2011, 03:34 AM
Friend of Wrox
Join Date: Sep 2010
Posts: 171
Thanks: 0
Thanked 14 Times in 14 Posts

you need to use the length function in that statement. try:
If Len(Dir(FromFileName)) > 0 Then

Last edited by mtranchi; February 4th, 2011 at 02:30 PM..

Similar Threads
Thread Thread Starter Forum Replies Last Post
break for-each loops, or limit amount of loops warhero XSLT 2 July 4th, 2007 02:18 AM
Loops deontae45 VB.NET 2002/2003 Basics 2 September 28th, 2006 03:48 PM
Two Loops iloveoatmeal Classic ASP Basics 5 September 26th, 2005 09:59 AM
While loops and For loops in XSLT spencer.clark XSLT 1 August 5th, 2005 09:50 AM
loops flyn Javascript How-To 1 November 21st, 2003 04:59 AM

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.