We help IT Professionals succeed at work.

InStr with Wildcards Function

JenH2
JenH2 asked
on
I'm trying to use a function I found here: http://www.visualbasic.happycodings.com/Other/code26.html

However, when I run my script, I get the following error:

Line:    1
Char:   29
Error:   Expected ')'
Code:  800A03EE

For the life of me I can't figure out why it would look for a ) to be at that character spot.  Any ideas?

Function InStr2(sSearchText As String, sForText As String, Optional ByVal lStart As Long = 1, Optional bCompareText As Boolean = False) As Long
    Dim lWildCardStartPos As Long, lWildCardPos As Long, lWildCardEndPos As Long
    Dim sSubtext As String, lCompare As Long
    
    'Set variables
    lWildCardStartPos = lStart
    If bCompareText Then
        lCompare = vbTextCompare
    Else
        lCompare = vbBinaryCompare
    End If
    
    Do
        'Search for wildcard
        lWildCardPos = InStr(lWildCardPos + 1, sForText, "*")
        If lWildCardPos Then
            lWildCardEndPos = lWildCardPos - 1
        Else
            lWildCardEndPos = Len(sForText)
        End If
        
        'Search input text
        sSubtext = Mid$(sForText, lWildCardStartPos, lWildCardEndPos - lWildCardStartPos + 1)
        lStart = InStr(lStart, sSearchText, sSubtext, lCompare)
        
        'Check exit conditions
        If lStart = 0 Then
            'Clear value and exit do
            Instr2 = 0
            Exit Do
        ElseIf Instr2 = 0 Then
            'Store value
            Instr2 = lStart
        End If
        If lWildCardPos = 0 Then
            Exit Do
        End If
        lWildCardStartPos = lWildCardPos + 1
    Loop
End Function

Open in new window

Comment
Watch Question

Author

Commented:
Let me be clearer on my "Any ideas?" question.
Any ideas that don't require me to sign up for a site that wants 10 bucks a month?  Where's the "Mark Post As Spam" button?
Are you using VB or VB Script?

In VB Script, there are no types (String, Long, Boolean etc.) Everything is considered as Variant
Test your restores, not your backups...
Expert of the Year 2019
Top Expert 2016
Commented:
The problem is you are trying to use a Visual Basic piece of code in a VB Script program, and the syntax is different between the two.  A lot is the same, but some is different.  In your case you are getting an error because VB Script doesn't allow typing variables (or parms) while Visual Basic does.

So your Function() needs to be something like:

Function InStr2(sSearchText, sForText, lStart, bCompareText)

But you have other lines that will need converting as well, like the DIM statements, etc.  

To do a conversion of this function to VB Script I would want to know more about how you intend to call and use it in a VB Script.

~bp

Author

Commented:
Ahhhh!!!!  Thank you guys!
What I'm doing is opening an excel file, then a search.txt file.  I then have a loop within a loop.  It reads a row of the excel file, then loops through the text file to see if any of the strings in the text file show up in on of the cells.  The search strings sometimes have wildcards (only *, not ? or anything else).  If it finds one of the strings then it copies the row of data into a seperate excel sheet.  Then the first loop continues on, reading the next row in the original excel file.
So to fix this Function, I need to take out all the "As X" stuff in the Dim statements as well and then I should be good to go?

Author

Commented:
So, looks like the function is ok, at least I don't get any errors from it.  Now I'm getting an error on Line 71, Char 1, Error: Unknown runtime error.  But... it looks fine to me...  ?
strExcelCVS = "C:\Users\hopkinsr\Desktop\bjlee10_06_08to10_06_08.csv"
srtExcelOUT = "C:\Users\hopkinsr\Desktop\output.xlsx"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSearchList = objFSO.OpenTextFile("C:\Users\hopkinsr\Desktop\search.txt")
Set objExcelCSV = CreateObject("Excel.Application")
objExcelCSV.Visible = True
objExcelCSV.DisplayAlerts = False
objExcelCSV.WorkBooks.Open strExcelCVS
objExcelCSV.Columns(50).Delete
objExcelCSV.Columns(49).Delete
objExcelCSV.Columns(48).Delete
objExcelCSV.Columns(47).Delete
objExcelCSV.Columns(46).Delete
objExcelCSV.Columns(45).Delete
objExcelCSV.Columns(44).Delete
objExcelCSV.Columns(43).Delete
objExcelCSV.Columns(42).Delete
objExcelCSV.Columns(41).Delete
objExcelCSV.Columns(40).Delete
objExcelCSV.Columns(39).Delete
objExcelCSV.Columns(38).Delete
objExcelCSV.Columns(37).Delete
objExcelCSV.Columns(36).Delete
objExcelCSV.Columns(35).Delete
objExcelCSV.Columns(32).Delete
objExcelCSV.Columns(31).Delete
objExcelCSV.Columns(30).Delete
objExcelCSV.Columns(29).Delete
objExcelCSV.Columns(28).Delete
objExcelCSV.Columns(27).Delete
objExcelCSV.Columns(26).Delete
objExcelCSV.Columns(16).Delete
objExcelCSV.Columns(15).Delete
objExcelCSV.Columns(14).Delete
objExcelCSV.Columns(13).Delete
objExcelCSV.Columns(12).Delete
objExcelCSV.Columns(11).Delete
objExcelCSV.Columns(10).Delete
objExcelCSV.Columns(9).Delete
objExcelCSV.Columns(16).Delete


Set objExcelOUT = CreateObject("Excel.Application")
objExcelOUT.Visible = True
objExcelOUT.DisplayAlerts = False
objExcelOUT.Workbooks.Add
objExcelOUT.ActiveWorkbook.Worksheets.Add
Set objSheetOUT = objExcelOUT.ActiveWorkbook.Worksheets(1)
objSheetOUT.Range("A1:P1").Font.Bold = True
objSheetOUT.Cells(1, 1).Value = "PROCESS_NAME"
objSheetOUT.Cells(1, 2).Value = "USERGROUP_NAME"
objSheetOUT.Cells(1, 3).Value = "GROUP_NAME"
objSheetOUT.Cells(1, 4).Value = "EVENT_NAME"
objSheetOUT.Cells(1, 5).Value = "BEGIN_TIME"
objSheetOUT.Cells(1, 6).Value = "COMPUTER_NAME"
objSheetOUT.Cells(1, 7).Value = "WAS_ALERT"
objSheetOUT.Cells(1, 8).Value = "SRC_DRIVE_NAME"
objSheetOUT.Cells(1, 9).Value = "DEST_DRIVE_NAME"
objSheetOUT.Cells(1, 10).Value = "DEST_REMOVABLE"
objSheetOUT.Cells(1, 11).Value = "SRC_FILE_NAME"
objSheetOUT.Cells(1, 12).Value = "SRC_FILE_DIRECTORY"
objSheetOUT.Cells(1, 13).Value = "DEST_FILE_NAME"
objSheetOUT.Cells(1, 14).Value = "DEST_FILE_DIRECTORY"
objSheetOUT.Cells(1, 15).Value = "FILE_SIZE"
objSheetOUT.Cells(1, 16).Value = "FILE_SIZE_KB"

CSVROW = 2
OUTROW = 2

Do Until objExcelCSV.Cells(SVCROW,1).Value = ""

	Do While Not objSearchList.AtEndOfStream
 		strSearchCriteria = objSearchList.ReadLine
		If InStr2(objExcelCSV.Cells(SVCROW,11).Value, strSearchCriteria) <> 0 Then
			objSheetOUT.Cells(SVCROW,1).Value = objExcelCSV.Cells(SVCROW,1).Value
			objSheetOUT.Cells(SVCROW,2).Value = objExcelCSV.Cells(SVCROW,2).Value
			objSheetOUT.Cells(SVCROW,3).Value = objExcelCSV.Cells(SVCROW,3).Value
			objSheetOUT.Cells(SVCROW,4).Value = objExcelCSV.Cells(SVCROW,4).Value
			objSheetOUT.Cells(SVCROW,5).Value = objExcelCSV.Cells(SVCROW,5).Value
			objSheetOUT.Cells(SVCROW,6).Value = objExcelCSV.Cells(SVCROW,6).Value
			objSheetOUT.Cells(SVCROW,7).Value = objExcelCSV.Cells(SVCROW,7).Value
			objSheetOUT.Cells(SVCROW,8).Value = objExcelCSV.Cells(SVCROW,8).Value
			objSheetOUT.Cells(SVCROW,9).Value = objExcelCSV.Cells(SVCROW,9).Value
			objSheetOUT.Cells(SVCROW,10).Value = objExcelCSV.Cells(SVCROW,10).Value
			objSheetOUT.Cells(SVCROW,11).Value = objExcelCSV.Cells(SVCROW,11).Value
			objSheetOUT.Cells(SVCROW,12).Value = objExcelCSV.Cells(SVCROW,12).Value
			objSheetOUT.Cells(SVCROW,13).Value = objExcelCSV.Cells(SVCROW,13).Value
			objSheetOUT.Cells(SVCROW,14).Value = objExcelCSV.Cells(SVCROW,14).Value
			objSheetOUT.Cells(SVCROW,15).Value = objExcelCSV.Cells(SVCROW,15).Value
			objSheetOUT.Cells(SVCROW,16).Value = objExcelCSV.Cells(SVCROW,16).Value
			OUTROW = OUTROW + 1
		End If
		CSVROW = CSVROW + 1
	Loop

Loop

objExcelOUT.ActiveWorkbook.SaveAs srtExcelOUT
objExcelOUT.ActiveWorkbook.Close
objExcelCSV.ActiveWorkbook.Close
objExcelCSV.Application.Quit
objExcelOUT.Application.Quit

WScript.Echo "Done"

Function InStr2(sSearchText, sForText, lStart, bCompareText)
    Dim lWildCardStartPos, lWildCardPos, lWildCardEndPos
    Dim sSubtext, lCompare
    
    'Set variables
    lWildCardStartPos = lStart
    If bCompareText Then
        lCompare = vbTextCompare
    Else
        lCompare = vbBinaryCompare
    End If
    
    Do
        'Search for wildcard
        lWildCardPos = InStr(lWildCardPos + 1, sForText, "*")
        If lWildCardPos Then
            lWildCardEndPos = lWildCardPos - 1
        Else
            lWildCardEndPos = Len(sForText)
        End If
        
        'Search input text
        sSubtext = Mid(sForText, lWildCardStartPos, lWildCardEndPos - lWildCardStartPos + 1)
        lStart = InStr(lStart, sSearchText, sSubtext, lCompare)
        
        'Check exit conditions
        If lStart = 0 Then
            'Clear value and exit do
            Instr2 = 0
            Exit Do
        ElseIf Instr2 = 0 Then
            'Store value
            Instr2 = lStart
        End If
        If lWildCardPos = 0 Then
            Exit Do
        End If
        lWildCardStartPos = lWildCardPos + 1
    Loop
End Function

Open in new window

Bill PrewTest your restores, not your backups...
Expert of the Year 2019
Top Expert 2016

Commented:
In line 71 I see:

Do Until objExcelCSV.Cells(SVCROW,1).Value = ""

But I don't see SVCROW assigned a value anyplace ???

~bp
Commented:
HI There
Line 68 may be a mispelling.... it may need to be SVC or either that, all the SVCROW needs to be CSVROW  that follow line 68.
at the end of the loop you then add 1 to CSVROW but and try to use SVCROW in the loop.
 
Hope that helps
Regards
Krystian

Author

Commented:
Thank you everyone for your help working this all out, it was one of those last minute "Quick, script this process NOW!" deals.