Results 1 to 5 of 5
  1. #1
    Join Date
    Aug 2007
    Posts
    88

    Unanswered: get specific line in text file and paste in Excel cell

    I have a big text file (about 4000 lines) with tab delimited fields. Is there any way I can get a specific line (for example line 3950) data and paste in a specific cell in Excel?

    I currently convert the entire text file to an excel file and copy row 3950 to another Excel file. It takes too long, since the program need to deal with a couple dozens of files like that. It will be much better if I can just get a specific line only and paste to Excel to reduce the processing time.

    Thank you very much for help!

  2. #2
    Join Date
    Jan 2009
    Location
    Kerala, India
    Posts
    183

    get specific line in text file and paste in Excel cell

    You may try the following code:
    Code:
    Public Function ExtractText()
    Dim ExcelSheet As Object, msg As String
    Dim row As Long, col As Long, lineNo As Long
    Dim txtFileName As String, counter As Long
    Dim txtline As String, response As Integer
    
    On Error GoTo ExtractText_Err
    
    Set ExcelSheet = CreateObject("Excel.Sheet")
    ExcelSheet.Application.Visible = True
    row = 0: col = 1
    
    
    txtFileName = Nz(InputBox("Enter Text File PathName:", "ExtractText()"), "")
    If txtFileName = "" Then
       Exit Function
    ElseIf Len(Dir(txtFileName)) = 0 Then
       Exit Function
    End If
    
    Repeat:
    lineNo = Nz(InputBox("Enter Text File Line Number", "ExtractText()"), 0)
    If lineNo = 0 Then
       Exit Function
    End If
    Open txtFileName For Input As #1
    counter = 0
    Do While Not EOF(1) And counter < lineNo
       counter = counter + 1
       Line Input #1, txtline
       Debug.Print counter, txtline
    Loop
    Close #1
    row = row + 1
    ExcelSheet.Application.Cells(row, col).Value = txtline
    response = 0
    Do While response < 1 Or response > 2
       msg = "1.  Repeat" & vbCr & vbCr & "2. Quit" & vbCr & vbCr & "Select 1 or 2?"
       response = Nz(InputBox(msg, "ExtractText()"), 0)
    Loop
    If response = 1 Then GoTo Repeat
    
    ExcelSheet.SaveAs "C:\Users\user\Desktop\TXT" & Format(Date, "0") & "-" & Int(Timer) & ".XLS"
    ExcelSheet.Application.Quit
    Set ExcelSheet = Nothing
    
    ExtractText_Exit:
    Exit Function
    
    ExtractText_Err:
    MsgBox Err.Description, , "ExtractText()"
    Resume ExtractText_Exit
    End Function
    Program creates a new Excel file with a unique name with a single worksheet. Modify the target location hardcoded in the program as per your requirement.
    www.MsAccessTips.com (Learn MS-Access Tips & Tricks)
    Learn Advanced MS-Access Programming with sample VBA Code.

    All responses are based on Access 2003/2007

  3. #3
    Join Date
    Aug 2007
    Posts
    88
    apr pillai,

    Thanks so much! It works like a charm to output the line in a cell in excel. Very fast!

    I need to do this in an access application so I need to change a little bit to fit in access.
    If there any way that I can further split the line with tab delimiter and paste in excel row so each element will be pasted in one single cell? I change the code as below but error out with the error message "Object variables or With Block variable not set". I guess the error is at the line .ActiveSheet.Range(Chr(65 + intCol) & CStr(intRow)).Select

    Thank you very much so your wonderful code!

    Public Function ExtractText()
    Dim appExcel As Excel.Application
    Dim varElements As Variant

    Dim ExcelSheet As Object, msg As String
    Dim row As Long, col As Long, lineNo As Long
    Dim txtFileName As String, counter As Long
    Dim txtline As String, response As Integer
    Dim intCol As Long
    Dim intRow As Long
    Dim delim1 As String
    delim1 = Chr(9) 'or vbtab Tab character
    On Error GoTo ExtractText_Err
    Set appExcel = New Excel.Application

    row = 1: col = 1


    txtFileName = Nz(InputBox("Enter Text File PathName:", "ExtractText()"), "")
    If txtFileName = "" Then
    Exit Function
    ElseIf Len(Dir(txtFileName)) = 0 Then
    Exit Function
    End If

    Repeat:
    lineNo = Nz(InputBox("Enter Text File Line Number", "ExtractText()"), 0)
    If lineNo = 0 Then
    Exit Function
    End If
    Open txtFileName For Input As #1
    counter = 0
    Do While Not EOF(1) And counter < lineNo
    counter = counter + 1
    Line Input #1, txtline
    Debug.Print counter, txtline
    Loop
    Close #1

    With appExcel
    .Visible = True

    .Workbooks.Add


    varElements = Split(txtline, delim1)
    For intCol = 1 To UBound(varElements)

    .ActiveSheet.Range(Chr(65 + intCol) & CStr(intRow)).Select
    .Selection = varElements(intCol)

    Next intCol


    Do While response < 1 Or response > 2
    msg = "1. Repeat" & vbCr & vbCr & "2. Quit" & vbCr & vbCr & "Select 1 or 2?"
    response = Nz(InputBox(msg, "ExtractText()"), 0)
    Loop
    If response = 1 Then GoTo Repeat


    .ActiveWorkbook.SaveAs "C:\windows\temp\TXT" & Format(Date, "0") & "-" & Int(Timer) & ".XLS"
    .Quit

    End With
    Set appExcel = Nothing

    ExtractText_Exit:
    Exit Function

    ExtractText_Err:
    MsgBox Err.Description, , "ExtractText()"
    Resume ExtractText_Exit
    End Function

  4. #4
    Join Date
    Jan 2009
    Location
    Kerala, India
    Posts
    183
    I think you don't need a dot at the beginning of this statement:

    Code:
    .ActiveSheet.Range(Chr(65 + intCol) & CStr(intRow)).Select
    www.MsAccessTips.com (Learn MS-Access Tips & Tricks)
    Learn Advanced MS-Access Programming with sample VBA Code.

    All responses are based on Access 2003/2007

  5. #5
    Join Date
    Aug 2007
    Posts
    88
    Thank you for reply. I tried to remove the dot, but still get the same error. It seems the dot is required.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •