Importing Multiple Text File in Excel

[potter.justin]

Hi,

I am trying to come up with a way to import multiple text files into
excel. What I want to do is import each text file to a seperate
worksheet, I would like to be able to run the macro once a week and
pull in any new (or all) the text files into excel. If it is easier
to just pull the whole folder I want the existing sheets to be
overwritten. I have somewhat limited experience with VBA, but after
browsing the forums this is what i have come up with:

Sub GetFiles()
Dim sPath As String, sName As String
Dim i As Long, qt As QueryTable
Dim sSheet As String
sPath = "C:\Documents and Settings\jpotter\Desktop\CSV\"
sName = Dir(sPath & "*.txt")
i = 0
Do While sName <> ""
i = i + 1
Cells(1, i).Value = sName
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sPath & sName, Destination:=Cells(1, 1))
.Name = Left(sName, Len(sName) - 4)
.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 = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
NewSheetName = "Sheet" + Str(i)
For j = 1 To Sheets.Count
If TypeName(Sheets(j)) = "Worksheet" Then
MyWorkSheetName = Sheets(j).Name
Else
End If
If MyWorkSheetName = NewSheetName Then
j = j + 1
'Next
Else
NewSheetName = "Sheet" + Str(i)
ActiveWorkbook.Worksheets.Add.Name = NewSheetName
Worksheets(NewSheetName).Select
End If
j = j + 1
Next

sName = Dir()
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next
Loop
'ActiveDocument.Save
End Sub


My problem that I am running into is that excel does not like the way
I am checking to see if the sheet is existing before creating a new
one. Any help would be greatly appreaciated.

Thanks,

Justin

 

[Tom Ogilvy]

If you want to overwrite the existing data then it would be easier to delete
all sheets except sheet1 (you always have to have at least one sheet), and
then just add sheets as needed - making a small exception for the first file
found which is written to sheet1. Since this delete sheets, test it on a
copy of your workbook until you are sure it does what you want.


Sub GetFiles()
Dim sPath As String, sName As String
Dim i As Long, qt As QueryTable
Dim sSheet As String, sh as worksheet
sPath = "C:\Documents and Settings\jpotter\Desktop\CSV\"
sName = Dir(sPath & "*.txt")
i = 0
if sName <> "" then
for each sh in worksheets
if sh.Name <> "Sheet1" then
application.Displayalerts = False
sh.Delete
application.DisplayAlerts = True
end if
Next
end if
Do While sName <> ""
i = i + 1
if i = 1 then
worksheets("Sheet1").Activate
cells.clear
else
worksheets.Add after:=Worksheets(worksheets.count)
Activesheet.Name = "Sheet" & i
end if
Cells(1, i).Value = sName
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sPath & sName, Destination:=Cells(2, 1))
.Name = Left(sName, Len(sName) - 4)
.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 = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
sName = Dir()
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next
Loop
'ActiveDocument.Save
End Sub

 

[Ron de Bruin]

Try this example that use a macro from Chip Pearson

Change the path to your path
MyPath = "C:\Users\Ron\test"

Sub Example2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mysheet As Worksheet
Dim basebook As Workbook

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no txt files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.txt")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook

'Fill the array(myFiles)with the list of txt files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mysheet = Worksheets.Add
mysheet.Name = MyFiles(Fnum)

' Call Chip Pearson's macro
ImportTextFile MyPath & MyFiles(Fnum), " "

Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub


Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1

End Sub

 

[potter.justin]

If you want to overwrite the existing data then it would be easier to delete
all sheets except sheet1 (you always have to have at least one sheet), and
then just add sheets as needed - making a small exception for the first file
found which is written to sheet1. Since this delete sheets, test it on a
copy of your workbook until you are sure it does what you want.

Sub GetFiles()
Dim sPath As String, sName As String
Dim i As Long, qt As QueryTable
Dim sSheet As String, sh as worksheet
sPath = "C:\Documents and Settings\jpotter\Desktop\CSV\"
sName = Dir(sPath & "*.txt")
i = 0
if sName <> "" then
for each sh in worksheets
if sh.Name <> "Sheet1" then
application.Displayalerts = False
sh.Delete
application.DisplayAlerts = True
end if
Next
end if
Do While sName <> ""
i = i + 1
if i = 1 then
worksheets("Sheet1").Activate
cells.clear
else
worksheets.Add after:=Worksheets(worksheets.count)
Activesheet.Name = "Sheet" & i
end if
Cells(1, i).Value = sName
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sPath & sName, Destination:=Cells(2, 1))
.Name = Left(sName, Len(sName) - 4)
.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 = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
sName = Dir()
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next
Loop
'ActiveDocument.Save
End Sub

--
Regards,
Tom Ogilvy









- Show quoted text -

Looks like it will accomplish what I want. Thanks.

 

[Mauri Carrasco]

Hi Ron,

How would you adjust the code such that the macro imports all the text files into one worksheet -- one after another -- in a pre set width ie fixed width, not delimited?

Thanks for the help!