Link to home
Start Free TrialLog in
Avatar of JenH2
JenH2Flag for United States of America

asked on

InStr with Wildcards Function

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

Avatar of JenH2
JenH2
Flag of United States of America image

ASKER

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?
SOLUTION
Avatar of Harisha M G
Harisha M G
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of JenH2

ASKER

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?
Avatar of JenH2

ASKER

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

Avatar of Bill Prew
Bill Prew

In line 71 I see:

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

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

~bp
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of JenH2

ASKER

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