import part of text from txt to excel

[sai_sl]

Hello everyone! I need may be some VBA script or something else to solve my problem) I have many txt files in one folder. Each file contain information like:

some text here
some text here
some text here
start to copy
some text here
some text here
some text here
end of copy
some text here
some text here
some text here


So i need to copy/import text include "start to copy" and "end of copy" to one column in excel.

Sceenshot for example in attach.


Thanks for your help!

 

[Logit]

Option Explicit

Sub ImportTXTFiles()
    Dim importrow As Long
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    With ActiveSheet

        For Each txtfile In txtfilesToOpen

            importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row
            
            With .QueryTables.Add(Connection:="TEXT;" & txtfile, _
              Destination:=.Cells(importrow, 1))
                .TextFileParseType = xlDelimited
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
                .Refresh BackgroundQuery:=False
            End With


        Next txtfile

        For Each qt In .QueryTables
            qt.Delete
        Next qt

    End With

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

Download file : Import Txt Files All To Sheet One.xlsm

 

[sai_sl]

Option Explicit

Sub ImportTXTFiles()
    Dim importrow As Long
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim qt As QueryTable
    Dim txtfilesToOpen As Variant, txtfile As Variant

    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")

    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")

    With ActiveSheet

        For Each txtfile In txtfilesToOpen

            importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row
           
            With .QueryTables.Add(Connection:="TEXT;" & txtfile, _
              Destination:=.Cells(importrow, 1))
                .TextFileParseType = xlDelimited
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileOtherDelimiter = "|"
                .Refresh BackgroundQuery:=False
            End With


        Next txtfile

        For Each qt In .QueryTables
            qt.Delete
        Next qt

    End With

    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"

    Set fso = Nothing
End Sub

Download file : Import Txt Files All To Sheet One.xlsm

Thanks, but it's only import txt to excel without filter. I need import only part of text from txt

 

[Logit]

Will the rows to be copied always be the same ?

OR -

Will the first row in the copy always have the same term , and will there always be the same number of rows after that to be copied ?

 

[sai_sl]

Ok, yet one example

This is txt file

after import to excel, i need this result

Numbers of rows between vst_start and vst_end may be random

 

[Logit]

I am at a loss how to assist with these requirements. Another volunteer on the Forum will provide the answer for you.

Thank you for the opportunity.

 

[Marc L]

I have many txt files in one folder

Hello ! What is the End Of Line sequence of your text files ?​

If you do not know so just link a couple of these text files on a files host website like Dropbox …​

​

Where are located these text files, in same workbook folder or … ?​

As guessing can't be coding …​

 

[sai_sl]

Thanks all. My problem was solved.

Option Explicit
  
Const vst_start = "vst_start"
Const vst_end = "vst_end"
  
Sub ImportTXTFiles()
    Dim importrow As Long
    Dim fso As Object
    Dim xlsheet As Worksheet
    Dim txtfilesToOpen As Variant, txtfile As Variant
  
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
  
    txtfilesToOpen = Application.GetOpenFilename _
                 (FileFilter:="Text Files (*.txt), *.txt", _
                  MultiSelect:=True, Title:="Text Files to Open")
  
    With ActiveSheet
        Dim txt As String
        Dim arr As Variant
        Dim brr As Variant
        Dim vv As Variant
        For Each txtfile In txtfilesToOpen
             
            With fso.OpenTextFile(txtfile, 1, False)
                txt = .ReadAll
                .Close
            End With
             
            arr = Split(txt, vst_start)
             
            If Not IsEmpty(arr) Then
                For Each vv In arr
                    If InStr(vv, vst_end) > 0 Then
                        txt = Split(vv, vst_end)(0)
                        txt = Join(Array(vst_start, txt, vst_end), "")
                        brr = Split(txt, vbCrLf)
                         
                        importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row
                        .Cells(importrow, 1).Resize(UBound(brr) + 1, 1) = Application.Transpose(brr)
                    End If
                Next
            End If
        Next txtfile
  
    End With
  
    Application.ScreenUpdating = True
    MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"
  
    Set fso = Nothing
End Sub