importing several text files into different excel worksheet
In article , annsmjarm
says...
Hi,
How to handle more than one importing text files into different
worksheets in one excel file? I have the macro as follow and please
give me some ideas of doing it.
Thanks!
Anne
Below is a segment of code I use to bring up a file select
dialogue box, and then load the selected file/s into a seperate sheet
each. The text files I work with are of consistant format and comprise a
tab delimited database.
The 'import' section is what the macro recorder gave me after I
used the import wizard. It can probably be cleaned up no end, but I've
not bothered with it yet.
I have 4 sheets at the start of my workbook which do not get
removed. Reference is made to them through the code, but it should be
easy to pick and either delete or amend.
I've documented it a bit, as other users at my work may need to
make something of it since I do not intend to maintain or adapt anything
for them =).
See ya
Ken McLennan
Qld, Australia
Here 'tis. I hope you can make something useful out of it.
------------------------------
Sub dataLoad()
' Macro for selecting files, loading data, sorting worksheets into
correct order and
' manipulating data for calculation and presentation on Analysis
worksheet.
' Was several individual routines but since each followed the other I
didn't need the overhead.
scrOff
Dim fileList As Variant
Dim x As Integer, y As Integer, nextRow As Integer
Dim newSht As Worksheet, importSht As Worksheet
Dim fName As String, connStr As String
Dim qTable As QueryTable
Dim arraySel As Range
' Sort worksheets into correct order:
' Analysis, Sumsheet, Report, Help
' Order of remaining worksheets is irrelevent
' They should be in order anyway
aSht.Move befo=Worksheets(1)
sSht.Move after:=aSht
rSht.Move after:=sSht
hSht.Move after:=rSht
' Open file selector
x = 1
fileList = Application.GetOpenFilename("Text Files (*.txt), *.txt",
MultiSelect:=True)
' Check for file/s selected, or dialogue cancelled.
If IsArray(fileList) Then
' If data has already been loaded, then clear it out prior
to
' selecting more data files.
If Worksheets.count 4 Then
clear_Data
End If
aSht.Activate ' Ensure first sheet remains on screen
scrOn ' Update screen to remove blank left by file dialogue
scrOff ' Turn screen off again to prevent flicker
' Parse list and open worksheets for each file
Do
fName = Mid(fileList(x), InStrRev(fileList(x), "\") + 1)
Set newSht = Worksheets.Add
newSht.Name = fName
newSht.Move after:=hSht
connStr = "Text;" & fileList(x)
Set importSht = Worksheets(fName)
Set qTable = Worksheets(fName).QueryTables.Add( _
Connection:=connStr, _
Destination:=Range("A1"))
' Import data to opened worksheet
With qTable
.Name = fName
.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 = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1,
1, 4, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
x = x + 1
Loop Until x = UBound(fileList) + 1
Else
Exit Sub ' 'Cancel' selected
End If
End Sub
|