string capture thru VBA

[Npsays]

Hi !

I need to capture some data in excel from a specific point in a .TXT file . IS there any command in VBA which can help me capture the same.? AS of now, it opens up the entrie file for me which exceeds 70000 records and excel would not load it completely. Please help.!

Thanks !

 

[sweater_vests_rock]

hi np.

i think this code (adopted from chip pearson's code at http://www.cpearson.com/excel/imptext.htm) should do the trick. i tested on a 65537 line file, and it imported properly. please note that if you do not need delimiters (such as "," or ";" to create multiple rows from a single line of text in your .txt file), just leave the box blank and select "OK". The code will assume that each row should be seperated with a carriage return (chr(13)).

cheers. ben.

Public Sub DoTheImport()

Dim FName As Variant
Dim Sep As String
Dim BeginLine As Long

FName = Application.GetOpenFilename _
    (filefilter:="Text Files(*.txt),*.txt,All Files (*.*),*.*")
If FName = False Then
    MsgBox "You didn't select a file"
    Exit Sub
End If

Sep = InputBox("Enter a single delimiter character.", _
        "Import Text File")

If Sep = "" Then Sep = Chr(13)
        
BeginLine = Application.InputBox _
    ("Enter the line number at which to begin importing.", "Beginning Line Number", _
    Type:=2)

If Not IsNumeric(BeginLine) Then
    MsgBox "You must enter an numeric value."
    Exit Sub
End If

Call ImportTextFile(CStr(FName), Sep, BeginLine)

End Sub

Public Sub ImportTextFile(FName As String, Sep As String, BeginLine As Long)

Dim RowNdx As Long
Dim ColNdx As Integer
Dim LineCount As Long
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:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

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
        LineCount = LineCount + 1
        TempVal = Mid(WholeLine, Pos, NextPos - Pos)
        If LineCount >= BeginLine Then Cells(RowNdx, ColNdx).Value = TempVal
        Pos = NextPos + 1
        ColNdx = ColNdx + 1
        NextPos = InStr(Pos, WholeLine, Sep)
    Wend
    If LineCount >= BeginLine Then RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1

End Sub

 

[Npsays]

Thanks for responding , i'll try this and would let you know if it worked ..i guess it should !