Sub Import1()
Dim rngStart As Range
Set oFS = CreateObject("Scripting.FileSystemObject")
FOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
Set oFile = oFS.OpenTextFile(FOpen, 1)
'Set outfile = oFS.CreateTextFile("c:\SaveDataFile.txt")
Set rngStart = ActiveCell
'save the split data at the currect active cell.
Dim myArr()
ReDim myArr(0)
Dim tempArr()
Do While Not oFile.AtEndOfStream
sData = oFile.Readline
If InStr(sData, vbTab) Then
strarr = Split(sData, vbTab)
If UBound(strarr) <= UBound(myArr) Then
SaveData myArr
myArr(UBound(strarr)) = strarr(UBound(strarr))
If UBound(strarr) < UBound(myArr) Then
ReDim tempArr(UBound(strarr))
For i = 0 To UBound(strarr)
tempArr(i) = myArr(i)
Next
ReDim Preserve myArr(UBound(strarr))
For i = 0 To UBound(myArr)
myArr(i) = tempArr(i)
Next
myArr(UBound(strarr)) = strarr(UBound(strarr))
End If
End If
If UBound(strarr) > UBound(myArr) Then
ReDim Preserve myArr(UBound(strarr))
myArr(UBound(strarr)) = strarr(UBound(strarr))
End If
Else
If UBound(myArr) > 0 Then SaveData myArr
ReDim myArr(0)
myArr(0) = sData
End If
Loop
SaveData myArr
oFile.Close
rngStart.Select 'move back to beginning
End Sub
Sub SaveData(arr As Variant)
For i = 0 To UBound(arr)
ActiveCell.Offset(0, i).Value = arr(i)
Next
ActiveCell.Offset(1, 0).Select
End Sub
|