none
VBA to search a file from a text RRS feed

  • Question

  • I tried to use the following code to search a file in VBA userform and works fine

    When I type a character in a text box, it search for a file ends with that character.

    Is it possible to get this reverse (instead of file name ends with that character, look for a file starts with that character)

    Sub SearchTextFile()   

    Const strFileName = "D:\MyFiles\TextFile.txt"   

    Const strSearch = "Some Text"   

    Dim strLine As String   

    Dim f As Integer   

    Dim lngLine As Long   

    Dim blnFound As Boolean   

    f = FreeFile   

    Open strFileName For Input As #f   

    Do While Not EOF(f)       

    lngLine = lngLine + 1       

    Line Input #f, strLine       

    If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then           

    MsgBox "Search string found in line " & lngLine, vbInformation           

    blnFound = True           

    Exit Do       

    End If   

    Loop    C

    lose #f   

    If Not blnFound Then       

    MsgBox "Search string not found", vbInformation   

    End If

    End Sub


    Saturday, December 19, 2015 10:21 PM

All replies

  • The code that you posted doesn't refer to a text box on a userform; it opens a file with a fixed name. Did you happen to post the wrong code?

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, December 19, 2015 10:28 PM
  • This is part of the code which controls the search part.

    It works fine. How can the search function looks for the start of the text string.

    Sunday, December 20, 2015 12:36 AM
  • Since you haven't posted the relevant part of the code, I can't help you.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, December 20, 2015 10:59 AM
  • Below is the code from the "FSO_UserForm"

    Private Sub Search_String_Change() Dim Extension          As String Call Analysis End Sub Public Sub Open1_Click() Dim xlApp As Excel.Application Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True Dim nDocType            As Long Dim nErrors             As Long If xls.Value = True Then Extension = ".xls" If Xlsm.Value = True Then Extension = ".xlsm" End Sub Private Sub Xlm_Click() Call Analysis End Sub Private Sub Xlsm_Click() Call Analysis End Sub Public Sub Exit1_Click() Unload Me End Sub Private Sub Index_Create_Click() strLine = "C:\Users\Home\Documents\microsoft-excel-files.txt" 'Debug.Print strLine Shell "CMD /C DIR /s /b C:\Users\Home\Documents\*.xl?? > " & strLine, vbShow End Sub Function Analysis() Dim Extension          As String Load FSO_UserFormCode = FSO_UserForm.Search_String.Text     strSearch = UCase(Code) & Extension    Dim strLine As String    Dim f As Integer    Dim lngLine As Long    Dim blnFound As Boolean    f = FreeFile    Open strFileName For Input As #f    Do While Not EOF(f)        lngLine = lngLine + 1        Line Input #f, strLine            If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 ThenFSO_UserForm.TB_Confirm.Text = "File Available"

    FSO_UserForm.TB_File_Found.Text = strLineCode = strLine    

    'Debug.Print Code            blnFound = True            'Debug.Print blnFound            Exit Do        End If    Loop    Close #f    If Not blnFound ThenFSO_UserForm.TB_Confirm.Text = "Sorry! File Not Available"    FSO_UserForm.TB_File_Found.Text = "Sorry! File Not Available"    strLine = strSearch    End If Code = strLine End Function

    Code from Module

    Option Explicit
    Public Code              As String
    Public nDocType            As Long
    Public Extension          As String
    Public strFileName          As String
    Sub Button1_Click()Load FSO_UserForm
    Call Input_Code
    If Len(Code) > 8 Then Code = 4567
    'Debug.Print Code
    strFileName = "C:\Users\Home\Documents\microsoft-excel-files.txt"
    FSO_UserForm.Search_String.SetFocus
    FSO_UserForm.Search_String.Text = Code
    FSO_UserForm.TB_File_Found.Text = Code
    FSO_UserForm.TextBox_Path_Index.Text = strFileName
    FSO_UserForm.ShowEnd SubFunction Input_Code()
    Dim DataObj As MsForms.DataObject
    Set DataObj = New MsForms.DataObjectDataObj.GetFromClipboard
    Code = Trim(DataObj.GetText(1))
    'Debug.Print Code
    End Function

    I have couple of issues with this code

    1. When I enter the search string, it doesn't search with the start letter/number

    2. When I click open, it doesn't open the file and shows error.




    • Edited by JoGey Sunday, December 20, 2015 5:53 PM
    Sunday, December 20, 2015 5:36 PM
  • If I understand the code correctly, this may do what you want.

    Userform code:

    Option Explicit
    
    Private Sub Search_String_Change()
        Call Analysis
    End Sub
    
    Public Sub Open1_Click()
        If Me.TB_Confirm.Text = "File Available" Then
            Workbooks.Open Filename:=Me.TB_File_Found.Text
        Else
            Beep
        End If
    End Sub
    
    Private Sub Xlm_Click()
        Call Analysis
    End Sub
    
    Private Sub Xlsm_Click()
        Call Analysis
    End Sub
    
    Public Sub Exit1_Click()
        Unload Me
    End Sub
    
    Private Sub Index_Create_Click()
        Shell "CMD /C DIR /s /b C:\Users\Home\Documents\*.xl?? > " & strFileName, vbShow
    End Sub
    
    Function Analysis()
        Dim f As Integer
        Dim strLine As String
        Dim blnFound As Boolean
        Code = Me.Search_String.Text
        If Me.xls.Value = True Then Extension = ".xls"
        If Me.Xlsm.Value = True Then Extension = ".xlsm"
        strSearch = UCase(Code) & "*" & Extension
        f = FreeFile
        Open strFileName For Input As #f
        Do While Not EOF(f)
            Line Input #f, strLine
            If strLine Like strSearch Then
                Me.TB_Confirm.Text = "File Available"
                Me.TB_File_Found.Text = strLine
                Code = strLine
                'Debug.Print Code
                blnFound = True
                'Debug.Print blnFound
                Exit Do
            End If
        Loop
        Close #f
        If Not blnFound Then
            Me.TB_Confirm.Text = "Sorry! File Not Available"
            Me.TB_File_Found.Text = "Sorry! File Not Available"
            strLine = strSearch
        End If
        Code = strLine
    End Function

    Standard module code:

    Option Explicit
    
    Public Code        As String
    Public Extension   As String
    Public strFileName As String
    
    Sub Button1_Click()
        Load FSO_UserForm
        Call Input_Code
        If Len(Code) > 8 Then Code = 4567
        'Debug.Print Code
        strFileName = "C:\Users\Home\Documents\microsoft-excel-files.txt"
        FSO_UserForm.Search_String.SetFocus
        FSO_UserForm.Search_String.Text = Code
        FSO_UserForm.TB_File_Found.Text = Code
        FSO_UserForm.TextBox_Path_Index.Text = strFileName
        FSO_UserForm.Show
    End Sub
    
    Function Input_Code()
        Dim DataObj As MsForms.DataObject
        Set DataObj = New MsForms.DataObjectDataObj.GetFromClipboard
        Code = Trim(DataObj.GetText(1))
        'Debug.Print Code
    End Function


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, December 20, 2015 8:57 PM