Wanting to create a search field and button to trigger VBA script to run

送分小仙女□ 提交于 2019-12-13 06:34:29

问题


I currently have a script which searches through a directory of .csv files to see if it contains a particular string I am looking for. What I would like to do is pair up this script with a text entry box and button (sort of like a search engine) and save it in an excel file, so any of my coworkers can just open it, search for what they need and click go/search, without any need to modify the VBA code. Here is the code I have thus far:

Sub SearchFolders()
    Dim fso As Object
    Dim fld As Object
    Dim strSearch As String
    Dim strPath 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 = "C:\where-im-searching\"
    strSearch = "what I'm Searching"

    Set wOut = Worksheets.Add
    lRow = 1
    With wOut
        .Cells(lRow, 1) = "Workbook"
        .Cells(lRow, 2) = "Worksheet"
        .Cells(lRow, 3) = "Cell"
        .Cells(lRow, 4) = "Text in Cell"
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.GetFolder(strPath)

        strFile = Dir(strPath & "\*.csv*")
        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) = wbk.Name
                        .Cells(lRow, 2) = wks.Name
                        .Cells(lRow, 3) = rFound.Address
                        .Cells(lRow, 4) = rFound.Value
                    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
    MsgBox "Done"

ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Set wbk = Nothing
    Set fld = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Exit Sub

    ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
    End Sub

So, I would like whatever is entered into the text entry box to be used for strSearch and then when the user clicks the button, it will trigger the above to run & search for whatever has been entered.

Thanks!


回答1:


From Microsoft's documentation:

  • On the Developer tab, in the Controls group, click Insert, and then under ActiveX Controls, click Command Button
  • Click the worksheet location where you want the upper-left corner of the command button to appear.
  • In the Controls group, click View Code.
    This starts the Visual Basic Editor. Make sure that Click is selected in the dropdown list on the right. The sub procedure called CommandButton1_Click is where you either paste your code or, preferably, put in a call to your working code.



回答2:


The most straightforward option would be to place a button on a worksheet (Developer -> Insert -> Form Controls -> Button) next to an input cell where the user types the search string. Assign the SearchFolders subroutine to the button and it will execute when the button is clicked. Modify the strSearch assignment so it takes the string from the input cell, in this case "A1":

strSearch = Range("A1").Value

You could alternatively create a userform with a textbox and a command button to do exactly the same thing, however the strSearch assignment would become something like:

strSearch = UserForm1.TextBox1.Value

You could extend this further to add a directory input cell / textbox in a similar manner.

Since you don't really need to open the csv in excel (usually quite a slow process), you could open each file in order as a FileSystemObject and parse them for the search string like this:

Sub SearchFolders()
    Dim fso As Object
    Dim fld As Object
    Dim fil As Object
    Dim ts As Object
    Dim strSearch As String
    Dim strPath As String
    Dim lineNumber As Integer

    strPath = "C:\where-im-searching\"
    strSearch = "what I'm Searching"

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strPath)

    For Each file In fld.Files

        Set ts = file.OpenAsTextStream()

        lineNumber = 0

        Do While Not ts.AtEndOfStream

            lineNumber = lineNumber + 1
            If InStr(ts.ReadLine, strSearch) Then
                Debug.Print "String found in " & file.Name & " on line " & lineNumber
            End If

        Loop

        ts.Close

    Next file

End Sub

Again, you can replace the search string with worksheet values or textbox values and allow the user change them. You could also change the Debug.Print statement to output back to the worksheet and use properties like file.Path to create a hyperlink.



来源:https://stackoverflow.com/questions/29540162/wanting-to-create-a-search-field-and-button-to-trigger-vba-script-to-run

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!