Hi
i wrote the code in one line. but when i pasted the code, my mailer inserted
the code new line automatically that caused syntax error. i think there is
more places which cause syntax error.
i'll put the code changed which would not cause syntax error when you copy.
But in case that there are syntax error again, please let me know.
Sub MultiImporttest()
Dim flname
Dim filename
Dim FileNum As Integer
Dim Counter As Long, maxrow As Long
Dim WorkResult As String
Dim ws As Worksheet
On Error GoTo ErrorCheck
maxrow = Cells.Rows.Count
filename = Application.GetOpenFilename _
(FileFilter:="all file(*.*),*.*", MultiSelect:=True)
If VarType(filename) = vbBoolean Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Counter = Cells(Cells.Rows.Count, "a").End(xlUp).Row
If Cells(Counter, "a") <> "" Then
Counter = Counter + 1
End If
For Each flname In filename
FileNum = FreeFile()
Open flname For Input As #FileNum
Do While Seek(FileNum) <= LOF(FileNum)
Application.StatusBar = "Importing Row " & _
Counter & " of text file " & flname
Line Input #FileNum, WorkResult
Set ws = Nothing
Set ws = ActiveSheet
ws.Select
Cells(Counter, 1) = WorkResult
If WorkResult <> "" Then
Application.DisplayAlerts = False
Cells(Counter, 1).TextToColumns _
Destination:=Cells(Counter, 1), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, _
Other:=False
End If
Counter = Counter + 1
If Counter > maxrow Then
MsgBox "data have over max rows: " & maxrow
Exit Sub
End If
Loop
Close
Next
Application.StatusBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
ErrorCheck:
Application.StatusBar = False
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "An error occured in the code."
End Sub
keizi