JenH2
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?
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
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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?
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?
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
In line 71 I see:
Do Until objExcelCSV.Cells(SVCROW,1 ).Value = ""
But I don't see SVCROW assigned a value anyplace ???
~bp
Do Until objExcelCSV.Cells(SVCROW,1
But I don't see SVCROW assigned a value anyplace ???
~bp
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you everyone for your help working this all out, it was one of those last minute "Quick, script this process NOW!" deals.
ASKER
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?