• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA code to extract string

twozedz

New Member
Hi I have the text below in a notepad file. I would like to extract strings that start with "TKT-" and end with ".xml"


SO the vba code will paste the following in the cells of a spreadsheet

TKT-YHDIDOSOOSD.XML

TKT-PYD-JHJHJSDSDSD.XML

TKT-JKSJDKSDJKSJD.XML

TKT-89823483hkshdfkhsd.XML


Can someone please help and point me in the right direction? Thanks heaps!!!!!!



TEXT IN NOTEPAD FILE:


TKT-YHDIDOSOOSD.XML hwew asdajsdasdh asdasdasdas TKT-PYD-JHJHJSDSDSD.XML


UDkhaishdkashdhasdas asdjasldjlasdasjdlasjdl jasldjlasjdlasjdlasjdlasjdaslkdjlasjdlasjdlasjdlas


kjlkhkashdkahskdhaskdhaskdhkasdhkashdkashdkashdkashdkashdkashdkashdkashdkashdkash

naksdhaskjdhkashdkashdkashdkashdkjashdkjashdkjashdkjashdkasjhdkajshdkas


ahkjsdhaksj


aslasdjalsjdask TKT-JKSJDKSDJKSJD.XML asdkaskdhaskdhasjhdkashdash TKT-89823483hkshdfkhsd.XML
 
Pls Don't duplicate the post. If u missed something in the initial post then you may add it later via new message...

I have deleted the another one!
 
There are various ways to read data from txt file.

Check this..

Code:
Sub read_Data()
Dim strFileName As String, file As Integer
Dim InputArrayLine As Variant, SplitLineArray As Variant, i As Integer, j As Integer, u As Integer
Dim finalArray() As Variant


strFileName = "C:\Users\dEEPAK\Desktop\test.txt"
file = FreeFile

Open strFileName For Input As #file
    InputArrayLine = Split(Input$(LOF(1), #file), vbLf)
Close #file


For i = LBound(InputArrayLine) To UBound(InputArrayLine)
    SplitLineArray = Split(InputArrayLine(i), " ")
        For j = LBound(SplitLineArray) To UBound(SplitLineArray)
            If InStr(1, SplitLineArray(j), "XML", vbTextCompare) > 0 Then
                ReDim Preserve finalArray(u)
                    finalArray(u) = SplitLineArray(j)
                        u = u + 1
            End If
        Next j
Next i

With Sheet1.Cells(1, 1)
    .CurrentRegion.Resize(, 1).Cells.Clear
    .Resize(UBound(finalArray) + 1) = Application.Transpose(finalArray)
End With

End Sub
 
Different method
Code:
Sub test()
    Dim fn As String, txt As String, i As Long, a() As String
    fn = Application.GetOpenFilename("TextFiles,*.txt")
    If fn = "False" Then Exit Sub
    Columns(1).ClearContents
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    With CreateObject("VBScript.RegExp")
        .Global = True: .IgnoreCase = True
        .Pattern = "(\S*?)\.xml"
        If .test(txt) Then
            ReDim a(1 To .Execute(txt).Count, 1 To 1)
            For i = 0 To .Execute(txt).Count - 1
                a(i + 1, 1) = .Execute(txt)(i)
            Next
        End If
    End With
    Cells(1).Resize(i).Value = a
End Sub
 
Last edited:
Back
Top