Hi,
How to handle more than one importing text files into differen
worksheets in one excel file? I have the macro as follow and pleas
give me some ideas of doing it.
Thanks!
Anne


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

Dim RowNdx As Integer
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:
Range("A2").Activate

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row


Open FName For Input Access Read As #1
Sheets("Data1").Select

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

Sub TextFile()
ImportTextFile01 "d:\data1.txt", vbTab

End Su

--
Message posted from http://www.ExcelForum.com

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