Importing text files asa group

J

JakeShipley2008

I have this macro which I will attach. IT currently has two issues.
1) When it brings the files into my active workbook it doesnt recognize to
delimit the files. It dumps the data into rows but does not seperate by
column.
2) It dumps one of the files into a new worksheet - when it does this that
one file is exported correctly.

What I need to accomplish is getting the files to dump correctly into my
active workbook.

Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (True)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDelimited, _
ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=True, _
Comma:=True, Space:=True, _
Other:=True, OtherChar:=","
x = 1

While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=ThisWorkbook.Sheets(Sheets.count)
.Worksheets(1).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDelimited, _
ConsecutiveDelimiter:=True, _
Tab:=True, Semicolon:=True, _
Comma:=Ture, Space:=True, _
Other:=True, OtherChar:=","
End With
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
 
D

Dave Peterson

First, it looks like you're trying to open a bunch of text files and create a
new worksheet in the workbook with the code for each of those files.

Second, did you really mean to use all those delimiters in your parsing
statement. That looked odd to me.

Third, ...

#1. Use "Workbooks.OpenText", not "workbooks.open"
#2. I think that this works ok:

Option Explicit
Sub CombineTextFiles2()
Dim FilesToOpen As Variant
Dim wkbTemp As Workbook
Dim iCtr As Long

Application.ScreenUpdating = False

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files, *.txt", _
MultiSelect:=True, Title:="Text Files to Open")

If IsArray(FilesToOpen) = False Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If

For iCtr = LBound(FilesToOpen) To UBound(FilesToOpen)
Workbooks.OpenText Filename:=FilesToOpen(iCtr), _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
Comma:=True, Space:=True, Other:=False

Set wkbTemp = ActiveWorkbook

wkbTemp.Worksheets(1).Copy _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

wkbTemp.Close savechanges:=False

Next iCtr

ExitHandler:
Application.ScreenUpdating = True
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

I changed somethings just because and others with good reason.

For instance:
wkbTemp.Sheets(1).Move After:=ThisWorkbook.Sheets(Sheets.count)

Sheets.count refers to the activeworkbook--which may not be ThisWorkbook.
...After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
is more explicit/safer.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top