This works great.
What would I need to do to import one text file into the current
workbook?
Or better yet, is there a way to import multiple long text files (500
columns) into the current workbook?

Joerg

Hellboy Wrote:
Sub Auto_open()
Dim szFile As String
Dim szLine As String
Dim tabl() As String
Dim szR As String
Dim iCols As Integer
Dim iA As Integer
Dim iFileNo As Integer
Dim iLines As Integer
Dim strInstring As String
Dim intInstring As Integer
' szDefaultDir = Cells(2, 3)
' ChDir szDefaultDir


vrtFiles = Application.GetOpenFilename("*.*, *.*", , "Fichier de Plus
de 255 Column", , True)
Application.ScreenUpdating = False
For Each fileToOpen In vrtFiles
If fileToOpen < False Then
bolStopAddSheet = True
szShortName = fileToOpen
szXLSfile = fileToOpen & ".XLS"
Workbooks.Add
Rem ActiveWorkbook.SaveAs szXLSfile
iFileNo = FreeFile
Open fileToOpen For Input As #iFileNo
iLines = 1
While Not EOF(iFileNo)
Line Input #iFileNo, szLine
szLine = Trim(szLine)
While Left(szLine, 1) = Chr(9) Or Left(szLine, 1) = ","
szLine = Mid(szLine, 2, Len(szLine))
Wend
While Right(szLine, 1) = Chr(9) Or Right(szLine, 1) = ","
szLine = Mid(szLine, 1, Len(szLine) - 1)
Wend
For intChar = 1 To 4
Select Case intChar
Case 1
intInstring = InStr(1, szLine, Chr(9))
'Tabulation
Case 2
intInstring = InStr(1, szLine, Chr(32)) 'Space
Case 3
intInstring = InStr(1, szLine, ",") 'Comma
Case 4
intInstring = InStr(1, szLine, ";") '
End Select
If intInstring 1 Then
strInstring = Mid(szLine, intInstring, 1)
Exit For
End If
Next intChar
szR = SplitFullCabane(tabl, szLine, strInstring, iLines)
iLines = iLines + 1
Wend
Close #iFileNo
End If
Sheets(1).Select
Next fileToOpen
End Sub

Function SplitFullCabane(tabstrTableau() As String, strLigne As String,
strSeparateur As String, intLines As Integer)

Dim nLoop As Integer
ReDim tabstrTableau(0, 254)
iSheet = 1
nLoop = 0
While InStr(strLigne, strSeparateur) 0
tabstrTableau(0, nLoop) = Trim(Left(strLigne, InStr(strLigne,
strSeparateur) - 1))
strLigne = Mid(strLigne, InStr(strLigne, strSeparateur) + 1)

While Left(strLigne, 1) = strSeparateur
strLigne = Mid(strLigne, 2)
Wend
nLoop = nLoop + 1
If nLoop = 255 Then
Rem iSheet = iSheet + 1
Sheets(iSheet).Range(Sheets(iSheet).Cells(intLines , 1),
Sheets(iSheet).Cells(intLines, 255)) = tabstrTableau
iSheet = iSheet + 1
If bolStopAddSheet = True Then
Sheets.Add after:=Sheets(iSheet - 1)
End If
ReDim tabstrTableau(0, 0)
ReDim tabstrTableau(0, 254)
nLoop = 0
End If
Wend
tabstrTableau(0, nLoop) = strLigne
Sheets(iSheet).Range(Sheets(iSheet).Cells(intLines , 1),
Sheets(iSheet).Cells(intLines, 255)) = tabstrTableau
ReDim tabstrTableau(0, 0)
ReDim tabstrTableau(0, 254)
If iSheet 1 Then bolStopAddSheet = False
End Function


--
joerg1004
------------------------------------------------------------------------
joerg1004's Profile: http://www.excelforum.com/member.php...o&userid=28089
View this thread: http://www.excelforum.com/showthread...hreadid=351496