Tukukkk

Is there any way I can do to extract the previous sentence or the line above the searched word?

I am trying to extract it from multiple text files. so far I only managed to get the searched term to pop up, but not the text above it.

I am kinda new in VBA so I did pick a few things from others who have codes that solved my problems.

Public errors As Integer

Public X As Variant

Public Y As Variant

Public Sub testing()

Dim fldr As FileDialog

Dim sItem As String



Dim z As Variant

Dim ID As String

Dim reminder As String

Dim confirmation As String

z = Now()

start:



If UserForm1.CommandButton1 = True Then

Set X = CommandButton1.Name

End If







   Y = Application.InputBox("Please enter your Employee ID", "For Verification Purposes", Type:=1)

   Select Case Y

   Case Y = ""

   Exit Sub

   End Select

   ID = MsgBox("Is your Employee ID, " & (Y) & ", correct?", vbYesNo, "Confirm?")

   Select Case ID

   Case vbYes

   GoTo foldersetting

   Case vbNo

   GoTo start

   End Select









foldersetting:

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

With fldr

.Title = "Select a Folder for " & (X)

.AllowMultiSelect = True

.InitialFileName = strPath

If .Show <> -1 Then GoTo NextCode

sItem = .SelectedItems(1)

End With



NextCode:

getfolder = sItem

Set fldr = Nothing



If getfolder = "" Then Exit Sub



Dim fso As Object

Dim fld As Object

Dim strSearch, strsearch1 As String

Dim strFile As String

Dim wOut As Worksheet

Dim wbk As Workbook

Dim wks As Worksheet

Dim lRow As Long

Dim rFound As Range

Dim strFirstAddress As String



' On Error GoTo ErrHandler

Application.ScreenUpdating = False







'Change as desired

strPath = sItem             '////////////////   <--- Change directory here  \\\\\\\\\\\\

strSearch = "Result: FAIL" '/////////////////    <--- Change term to search for here     \\\\\\\\\\\

Set wOut = Worksheets.Add



    Application.StatusBar = True



    Application.StatusBar = "Please Wait..."



lRow = 1

With wOut

    .Cells(lRow, 1) = "Type: " & (X)

    .Cells(lRow, 2) = "Employee ID: " & (Y)

    .Cells(lRow, 3) = "Date & Time of Extract: " & (z)

    .Cells(lRow, 4) = ""                        'Reserved for future use.

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fld = fso.getfolder(strPath)









    strFile = Dir(strPath & "*.txt")  '<-- Currently searching all Log files. Change extension here

    Do While strFile <> ""

        Set wbk = Workbooks.Open _

          (Filename:=strPath & "" & strFile, _

          UpdateLinks:=0, _

          ReadOnly:=True, _

          AddToMRU:=False)





        For Each wks In wbk.Worksheets

            Set rFound = wks.UsedRange.Find(strSearch)

            If Not rFound Is Nothing Then

                strFirstAddress = rFound.Address

            End If

            Do

                If rFound Is Nothing Then

                    Exit Do

                Else

                    lRow = lRow + 1

                    .Cells(lRow, 1) = rFound.Value



                    .Cells(lRow, 2) = wbk.Name





                End If

                Set rFound = wks.Cells.FindNext(after:=rFound)



            Loop While strFirstAddress <> rFound.Address

        Next





        wbk.Close (False)

        strFile = Dir





    Loop

    .Columns("A:D").EntireColumn.AutoFit





End With

errors = (ActiveSheet.UsedRange.Rows.Count - 1)





If (ActiveSheet.UsedRange.Rows.Count - 1) > 0 Then

MsgBox "There are " & (ActiveSheet.UsedRange.Rows.Count - 1) & " Failures Found!", vbCritical, "Warning"

ElseIf (ActiveSheet.UsedRange.Rows.Count - 1) = 0 Then

MsgBox "No errors found.", vbInformation, "No Errors"

Dim sh As Worksheet

Application.DisplayAlerts = False

For Each sh In Worksheets

Select Case sh.CodeName

Case "Sheet1", "Sheet2"

Case Else

sh.Delete

End Select

Next sh

Application.DisplayAlerts = True

End If



Dim lastrow As Long

lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 2



ActiveSheet.Cells(lastrow, "A").Value = "Number of Failures: " & 

(ActiveSheet.UsedRange.Rows.Count - 1)

On Error GoTo calling

Dim rngData As Range

Dim strData As String

Dim strTempFile As String



' copy some range values

Set rngData = wOut.Range("A:D")

rngData.Copy



' get the clipboard data

' magic code for is for early binding to MSForms.DataObject

With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    .GetFromClipboard

    strData = .GetText

End With



' write to temp file

strTempFile = "D:temp.txt"

With CreateObject("Scripting.FileSystemObject")

    ' true to overwrite existing temp file

    .CreateTextFile(strTempFile, True).Write strData

End With



' open notepad with tempfile

Shell "cmd /c ""notepad.exe """ & strTempFile & """", vbHide

calling:

Call log



ExitHandler:

Set wOut = Nothing

Set wks = Nothing

Set wbk = Nothing

Set fld = Nothing

Set fso = Nothing

Application.ScreenUpdating = True



Application.DisplayAlerts = False

For Each sh In Worksheets

Select Case sh.CodeName

Case "Sheet1", "Sheet2"

Case Else

sh.Delete

End Select

Next sh

Application.DisplayAlerts = True

Application.StatusBar = False



End Sub

eg: ( this exmaple comes from the actual text file. there are a lot of these files in a folder hence i chose to use folders to search)

Running Script Line 2960: DELAY 2000



Running Script Line 2961: AIC 6 3.71 3.87 {LDC}



Result: FAIL 3.546



Running Script Line 2963: LDCCONSOLE w "dacout(0x62E6)rn"



Result: OK



Running Script Line 2964: DELAY 2000



Running Script Line 2965: AIC 6 4.2 4.36 {LDC}



Result: FAIL 4.000



Running Script Line 2967: LDCCONSOLE w "dacout(0x6E24)rn"



Result: OK



Running Script Line 2968: DELAY 2000



Running Script Line 2969: AIC 6 4.67 4.83 {LDC}



Result: FAIL 4.454



Running Script Line 2971: LDCCONSOLE w "dacout(0x796A)rn"



Result: OK



Running Script Line 2972: DELAY 2000



Running Script Line 2973: AIC 6 5.15 5.31 {LDC}



Result: FAIL 4.901



Running Script Line 2975: LDCCONSOLE w "dacout(0x84B5)rn"



Result: OK



Running Script Line 2976: DELAY 2000



Running Script Line 2977: AIC 6 5.62 5.78 {LDC}



Result: FAIL 5.348



Running Script Line 2979: LDCCONSOLE w "dacout(0x9005)rn"



Result: OK



Running Script Line 2980: DELAY 2000



Running Script Line 2981: AIC 6 6.1 6.26 {LDC}



Result: FAIL 5.792



Running Script Line 2983: LDCCONSOLE w "dacout(0x9B5B)rn"



Result: OK



Running Script Line 2984: DELAY 2000



Running Script Line 2985: AIC 6 6.57 6.73 {LDC}



Result: FAIL 6.235



Running Script Line 2987: LDCCONSOLE w "dacout(0xA6B5)rn"



Result: OK



Running Script Line 2988: DELAY 2000



Running Script Line 2989: AIC 6 7.05 7.21 {LDC}



Result: FAIL 6.681



Running Script Line 2991: LDCCONSOLE w "dacout(0xB215)rn"



Result: OK



Running Script Line 2992: DELAY 2000



Running Script Line 2993: AIC 6 7.54 7.7 {LDC}



Result: FAIL 7.126



Running Script Line 2995: LDCCONSOLE w "dacout(0xBD7A)rn"



Result: OK



Running Script Line 2996: DELAY 2000



Running Script Line 2997: AIC 6 8.02 8.18 {LDC}



Result: FAIL 7.572

in this upper example, the searched term will be "result: FAIL" and what i hope vba will print out will be the searched term plus the previous line for each searched term. i have already managed to do the searched term part. so for those which results are ok will be ignored. for those that failed, like the last script line, it will be printed out as:

Running Script Line 2997: AIC 6 8.02 8.18 {LDC}



Result: FAIL 7.572