Looping through every file in a folder and opening certain ones in aspreadsheet

[R Tanner]

Hi,

I need to loop through a series of about 30 different csv files which
I plan to import into Excel based on the value of the inputbox. How
would I loop through every file in the folder though?

Thanks,

Robin

 

[Office_Novice]

Try Somthing like

Sub GetEm()
Dim FolderPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim colFiles As Object
Dim objFile As Object
Dim ws As Worksheet
Dim x As Variant

FolderPath = "C:\Documents and Settings\Desktop"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files
Set ws = ActiveWorkbook.Worksheets(1)
x = 1


For Each objFile In colFiles
'Do Stuff Here
Next
End Sub

 

[Office_Novice]

I think This may be exactly what you want.
Option Explicit
Sub GetEm()
Dim FolderPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim colFiles As Object
Dim objFile As Object
Dim MyCriteria As String
Dim ipBox As String
Dim ipBoxMessage As String
Dim ipBoxTitle As String

ipBoxMessage = "Type your Message Here"
ipBoxTitle = "Your Title Here"
ipBox = InputBox(ipBoxMessage, ipBoxTitle)

MyCriteria = ipBox

FolderPath = "C:\Documents and Settings\UserName\Desktop\ABC"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files

For Each objFile In colFiles
If InStr(1, objFile, MyCriteria) Then
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & objFile, _
Destination:=Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
Next
End Sub

 

[R Tanner]

what is the Scripting.filesystemobject doing?

This is the first step in my program. If I can figure out this part,
then the rest falls into place. I think what i would like to do is
parse all of the files that meet the specified criteria together into
one csv file and then import it into excel...Would that be too
difficult? All csv files have the same type of data...

 

[R Tanner]

I have read some articles that were talking about using Access to
import this data into and then read it from there in my code. The
only problem with that is that I don't have a danged clue how to use
Access, let alone write code in it.

 

[Ron de Bruin]

Try the add-in
http://www.rondebruin.nl/merge.htm

Or the code examples

 

[R Tanner]

Try the add-inhttp://www.rondebruin.nl/merge.htm

Or the code examples

I think it has become imperitive that I concatenate all of the csv
files into one before importing them because the destination property
of the querytables.add line cannot be modified for an offset
function...

 

[R Tanner]

Try the add-inhttp://www.rondebruin.nl/merge.htm

Or the code examples

I think it has become imperitive that I concatenate all of the csv
files into one before importing them because the destination property
of the querytables.add line cannot be modified for an offset
function...

 

[R Tanner]

Try the add-inhttp://www.rondebruin.nl/merge.htm

Or the code examples

I think it has become imperitive that I concatenate all of the csv
files into one before importing them because the destination property
of the querytables.add line cannot be modified for an offset
function...

 

[Office_Novice]

Hi Robin, The Code below looks for a file name or part of a file name to
import from a csv file. Each import will be the entire file and will be list
under the previous one in your worksheet Try this and post back if you have
anymore issues.

Sub GetEm()
Dim FolderPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim colFiles As Object
Dim objFile As Object
Dim MyCriteria As String
Dim ipBox As String
Dim ipBoxMessage As String
Dim ipBoxTitle As String
Dim i As Variant

ipBoxMessage = "Type your Message Here"
ipBoxTitle = "Your Title Here"
ipBox = InputBox(ipBoxMessage, ipBoxTitle)

MyCriteria = ipBox

FolderPath = "C:\Documents and Settings\username\Desktop\ABC"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files
i = ActiveWorkbook.Worksheets(1).Cells(Cells.Rows.Count,
1).End(xlUp).Offset(1, 0).Row
For Each objFile In colFiles
If InStr(1, objFile, MyCriteria) Then
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & objFile, _
Destination:=Range("A" & i))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
Next
End Sub

 

[ward376]

Use the code on this page on Ron's site:

http://www.rondebruin.nl/csv.htm

Cliff Edwards

 

[R Tanner]

Hi Robin, The Code below looks for a file name or part of a file name to
import from a csv file. Each import will be the entire file and will be list
under the previous one in your worksheet Try this and post back if you have
anymore issues.

Sub GetEm()
Dim FolderPath As String
Dim objFSO As Object
Dim objFolder As Object
Dim colFiles As Object
Dim objFile As Object
Dim MyCriteria As String
Dim ipBox As String
Dim ipBoxMessage As String
Dim ipBoxTitle As String
Dim i As Variant

ipBoxMessage = "Type your Message Here"
ipBoxTitle = "Your Title Here"
ipBox = InputBox(ipBoxMessage, ipBoxTitle)

MyCriteria = ipBox

FolderPath = "C:\Documents and Settings\username\Desktop\ABC"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FolderPath)
Set colFiles = objFolder.Files
i = ActiveWorkbook.Worksheets(1).Cells(Cells.Rows.Count,
1).End(xlUp).Offset(1, 0).Row
For Each objFile In colFiles
If InStr(1, objFile, MyCriteria) Then
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & objFile, _
Destination:=Range("A" & i))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
Next
End Sub

What do you want me to do with your variable 'i'? You declared it as
variant but set it equal to an object (a row) that is not used
anywhere else in the code...

 

[R Tanner]

What do you want me to do with your variable 'i'? You declared it as
variant but set it equal to an object (a row) that is not used
anywhere else in the code...

nevermind...works like a charm...

 

[R Tanner]

nevermind...works like a charm...

as much as I hate to say this, the requirement for the program has
changed. Instead of needing to open several files, our IT dept. will
be pulling the data for me into one massive csv file which will be
constantly updated. How can I open this csv file and go through the
file, row by row, and, if the date in that row is less than a
specified value, import it to the next empty row in excel...?

 

[R Tanner]

nevermind...works like a charm...

This is what I have thus far...It isn't doing a danged thing
though...I have to figure out how to find the date in each row and
then, if the date meets the criteria, import it into either another
csv file or excel...

Sub newtest()
Dim MyMessage As String
Dim MyDate As Date
Dim R As Integer


MyMessage = InputBox("Please enter the last date to include in the
report:")
MyDate = Left(MyMessage, 5)

R = 0


FileHandle = FreeFile

Open "Q:\Dropbox\Csv Files\08.01 Enter.txt" For Input Access Read Lock
Write As FileHandle

TextToFind = "#yyyy/mm/dd#"


Do Until EOF(FileHandle)
Line Input #1, Data
Select Case TextToFind
Case Is <= MyDate
ActiveCell.Offset(R, 0) = Data
R = R + 1
End Select
Loop
End Sub