I'm trying to use Range.Find(...) in VBScript (via Windows Script Host) however I can't seem to use any of the other options other than the search string as arguments, otherwise I get errors such as "syntax error" or "missing )".
I would like to search for AD#### in a cell (ie: AD followed by 4 numbers) however the only wildcards that seem to be available are ? (= one char/white space/number and * = any number of chars/white spaces/numbers.
If I could use the FindAt:=xlWhole then it would be ok however this just gives an error as stated above.
Any help would be appreciated, thanks. :)
excel.vbs
VBscript Range.Find for xlWhole &/or Number Wildcards
I would like to search for AD#### in a cell (ie: AD followed by 4 numbers) however the only wildcards that seem to be available are ? (= one char/white space/number and * = any number of chars/white spaces/numbers.
If I could use the FindAt:=xlWhole then it would be ok however this just gives an error as stated above.
Any help would be appreciated, thanks. :)
excel.vbs
Code:
REM Use this to help check for coding errors
Option Explicit
'On Error Resume Next ' comment out for debugging
REM Constants
Const xlWhole = &H1
Const csFolderName = "E:\TEST"
REM Variables
Dim objExcel
Dim objWkSheet
Dim objRange
Dim excelPath
Dim headingsStr
Dim resultStr
Dim findStr
Dim foundCell
Dim objFSO
Dim fileDescr
Dim objFolder
Dim objFile
Dim colFiles
Dim csvFileName
REM the csvFilename
csvFileName = csFolderName & "\Results.csv"
REM prepare for writing to a csv file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set fileDescr = objFSO.OpenTextFile(csvFileName, 2, True)
REM write the headings to the csv file
headingsStr = "Customer,Date,Quote#,Job#,Invoice#,Status,Quote $,Quote Hrs,Actual Hrs,PO#,Comments,Contact,Phone"
fileDescr.WriteLine headingsStr
REM open the folder of excel files to read from
Set objFolder = objFSO.GetFolder(csFolderName)
Set colFiles = objFolder.Files
REM get filenames of every excel file in the folder
For Each objFile in colFiles
REM only check Excel Files
If UCase(objFSO.GetExtensionName(objFile.Name)) = "XLS" Then
REM reset the result string for each file
resultStr = ""
REM file location
excelPath = csFolderName & "\" & objFile.Name
REM Create an invisible version of Excel
Set objExcel = CreateObject("Excel.Application")
'objExcel.visible = true ' only used for debugging
REM don't display messages about needing to be converted (old file formats)
objExcel.DisplayAlerts = 0
objExcel.ScreenUpdating = False
REM open the excel document as read-only
REM open (path, confirmconversions, readonly)
objExcel.Workbooks.open excelPath, false, true
REM select worksheet
Set objWkSheet = objExcel.ActiveWorkbook.Worksheets(1)
Set objRange = objExcel.ActiveSheet.UsedRange
REM ----------------- START FINDING DATA ----------------------------------
REM find Customer
findStr = "Customer:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
Else
findStr = "Depot"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
End If
End If
resultStr = resultStr & ","
REM find Date
findStr = "Date:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
End If
resultStr = resultStr & ","
REM find Quote Number
findStr = "Quote Number:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
Else
findStr = "AD*"
'findStr = "AD[0-9]*" ' wont work in VBscript
' "What:=" and ", LookAt:=xlWhole" wont work in VBscript, errors: syntax error or missing )
'Set foundCell = objExcel.ActiveSheet.UsedRange.Find (What:=findStr, LookAt:=xlWhole)
' works as xlPart but want xlWhole
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Value
WScript.Echo resultStr ' for debugging only
End If
End If
resultStr = resultStr & ","
REM find Job Number
findStr = "Call #"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
Else
findStr = "Call:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
End If
End If
resultStr = resultStr & ","
REM Invoice Number & Status
resultStr = resultStr & ",,"
REM find Quote Amount
findStr = "Sub Total:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
Else
findStr = "Sub Total"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 4).Value
End If
End If
resultStr = resultStr & ","
REM Quote Hours & Actual Hours
resultStr = resultStr & ",,"
REM find PO Number
findStr = "PO Number:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
Else
findStr = "Cust Order #"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
End If
End If
resultStr = resultStr & ","
REM Comments
resultStr = resultStr & ","
REM find Contact
findStr = "Contact:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
End If
resultStr = resultStr & ","
REM find Phone
findStr = "Phone:"
Set foundCell = objExcel.ActiveSheet.UsedRange.Find (findStr)
If Not FoundCell Is Nothing Then
resultStr = resultStr & foundCell.Offset(0, 1).Value
End If
resultStr = resultStr & ","
REM ----------------- FINISHED FINDING DATA ----------------------------------
REM write the result string to the csv file
fileDescr.WriteLine resultStr
'WScript.Echo resultStr ' only used for debugging
REM Close Excel
objExcel.ScreenUpdating = True
objExcel.Quit
End If
Next
REM confirm complete
WScript.Echo "Complete. Result file: " & csvFileName
REM Release from memory
Set objExcel = nothing
Set objFSO = nothing
Set objWkSheet = nothing
Set objRange = nothing
Set excelPath = nothing
Set headingsStr = nothing
Set resultStr = nothing
Set findStr = nothing
Set foundCell = nothing
Set fileDescr = nothing
Set objFolder = nothing
Set objFile = nothing
Set colFiles = nothing
Set csvFileName = nothing