On Aug 26, 3:38 pm, R Tanner wrote:
On Aug 26, 3:09 pm, R Tanner wrote:



On Aug 26, 2:34 pm, Office_Novice

wrote:
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.Coun t,
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

"R Tanner" wrote:
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.

On Aug 26, 12:02 pm, Office_Novice
wrote:
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" wrote:
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

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...

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