Database Search
If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.
TechHome
UDFs
- Determine Worksheet Names in Excel Workbook
- Sample UDFs from Stan Littlefield
- UDF to Test Existence of a URL
Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.
Sample UDFs from Stan Littlefield
Keywords: UDFs
;=========== Winbatch 2001 UDF's and Samples =======================
; submitted by Stan Littlefield
; used for Beta Testing of WB2001a
;
;=======================================================================
;section1
;=========== Date and Time Routines =====================================
; illustrates use of User Defined Functions to manipulate
; date values. Just cut out this section until you see the
; End of Routine comment, paste it into something like Dates.Wbt
;=======================================================================
#DefineFunction TimeVars()
today = formatd(TimeYmdHms())
localArray = ArrDimension(4,0,0,0,0)
localArray[0] = strsub( Timedate(),1,3 )
localArray[1] = int ( strsub(today,1,2) ) ; month
localArray[2] = int ( strsub(today,4,2) ) ; day
localArray[2] = int ( strsub(today,7,4) ) ; year
Return(localArray)
#EndFunction
#DefineFunction formatd(date)
Return(strcat( strsub(date,6,2),"/",strsub(date,9,2),"/",strsub(date,1,4) ))
#EndFunction
#DefineFunction bom(date)
;date must be in format mm/dd/yyyy as a string
Return( strcat( strsub(date,1,3),"01",strsub(date,6,5) ) )
#EndFunction
#DefineFunction bonm(date)
;date must be in format mm/dd/yyyy as a string
curmon = int( strsub(date,1,2) )
If curmon==12
nextmon='01'
Else
If curmon==9
nextmon='01'
Endif
If curmon<=8
nextmon = strcat("0",curmon+1)
Else
nextmon = strcat("",curmon+1)
Endif
Endif
Return( strcat( nextmon,"/01",strsub(date,6,5) ) )
#EndFunction
#DefineFunction eom(date)
;date must be in format mm/dd/yyyy as a string
mend = int( strsub(date,1,2) )
year = int( strsub(date,7,4) )
Switch mend
case 1
em="31"
break
case 2
If year mod 4 = 0
em="29"
Else
em="28"
Endif
break
case 3
em="31"
break
case 4
em="30"
break
case 5
em="31"
break
case 6
em="30"
break
case 7
em="31"
break
case 8
em="31"
break
case 9
em="30"
break
case 10
em="31"
break
case 11
em="30"
break
case 12
em="31"
break
EndSwitch
Return( strcat( strsub(date,1,3),em,strsub(date,6,5) ) )
#EndFunction
;first, test out the functions
today = formatd(TimeYmdHms())
message( "Todays Date",today )
message( "Beginning Of This Month",bom(today) )
message( "Beginning Of Next Month",bonm(today))
message( "End of This Month",eom(today))
;now test out modifying an array element
Array = TimeVars()
message ( "Current Day",Array[0] )
NewArray = Array
NewArray[0] = "April Fools!"
message ( NewArray[0],Array[0] )
exit
;================= End of Routine ======================================
;section2
; ///////////////////////////////////////////////////////
; Tests a UDF to build an Array from a Text File
; added test for new Arrinfo() function, and the
; Stan Littlefield 09/30/2000
; ///////////////////////////////////////////////////////
#DefineFunction formatd(date)
Return(strcat( strsub(date,6,2),"/",strsub(date,9,2),"/",strsub(date,1,4) ))
#EndFunction
#DefineFunction TimeVars()
today = formatd(TimeYmdHms())
localArray = ArrDimension(4,0,0,0,0)
localArray[0] = strsub( Timedate(),1,3 )
localArray[1] = int ( strsub(today,1,2) ) ; month
localArray[2] = int ( strsub(today,4,2) ) ; day
localArray[3] = int ( strsub(today,7,4) ) ; year
Return(localArray)
#EndFunction
#DefineFunction getinfo(PassedArray)
aInfo = ArrDimension(7,0,0,0,0)
aInfo[0] = ArrInfo(PassedArray,0)
aInfo[1] = ArrInfo(PassedArray,1)
aInfo[2] = ArrInfo(PassedArray,2)
aInfo[3] = ArrInfo(PassedArray,3)
aInfo[4] = ArrInfo(PassedArray,4)
aInfo[5] = ArrInfo(PassedArray,5)
aInfo[6] = ArrInfo(PassedArray,6)
Return(aInfo)
#EndFunction
#DefineFunction aFileRead(file)
IF FileExist(file) == @FALSE
Return(0)
Endif
localArray = ArrDimension(20,0,0,0,0)
i=0
cFile = FileOpen(file,"READ")
While @TRUE
x = FileRead(cFile)
If x == "*EOF*" Then Break
localArray[i]=x
i = i+1
EndWhile
FileClose(cFile)
Return(localArray)
#EndFunction
aTime = TimeVars()
; try renaming months.dat to months.sav to test this next code sequence
aArray = aFileRead("months.dat")
If ! ( VarType( aArray ) == 256 )
message("Error Occured","File Missing To Read into Array")
Else
aInfo = getinfo(aArray)
message("The Results",strcat("The Array Contains ",aInfo[1]," elements") )
message("The Current Month Is",aArray[ aTime[1] ] )
Endif
exit
; paste the lines below into a file called months.dat
; in order to run this
;
January
February
March
April
May
June
July
August
September
October
November
December
; end of paste
;================= End of Routine ======================================
;section3
; ///////////////////////////////////////////////////////
; this next routine illustrates passing OLE Objects
; to a UDF. Useful for creating generic OLE UDF's to
; handle data processing,
; ///////////////////////////////////////////////////////
#DefineFunction ExcelArray(DB,nSheet)
aArray = ArrDimension(10,0,0,0,0) ; assigns array to Objects
aArray[0] = DB.Visible
aArray[1] = DB.UserControl
aArray[2] = DB.Workbooks
aArray[2].Add()
aArray[3] = DB.ActiveWorkbook
aArray[4] = DB.Worksheets(1)
Return(aArray)
#EndFunction
DB = ObjectOpen("Excel.Application")
eArray = ExcelArray(DB,1)
eArray[0] = @TRUE ;now reference a generic array element
eArray[1] = @TRUE
eArray[4].Activate
oCell = eArray[4].Range("A1")
oCell.Value = 20.25
oCell = eArray[4].Range("B1")
oCell.Value = 10.75
oCell = eArray[4].Range("C1")
oCell.Formula = "=A1*B1"
oCell = eArray[4].Range("A1:C1")
oFont = oCell.Font
oFont.Size = 14
oFont.Bold = @TRUE
oFont.Italic = @TRUE
oFont = oCell.Interior
oFont.ColorIndex = 6
oFont = oCell.Borders
oFont.LineStyle = 12
oFont.Weight = 3
ObjectClose(DB)
exit
;================= End of Routine ======================================
;section4
; ///////////////////////////////////////////////////////
; Test Script for Working with JET Provider 4.0.
; And using the new arrays in Winbatch to hold
; Table Type and Table Names
;
; NOTE: even though Tbls = cat.Tables is defined in the script
; pass cat to the udf, not Tbls
;
; Stan Littlefield 09/24/2000
; ///////////////////////////////////////////////////////
#DefineFunction GetTables(nCount,cat)
lArray = ArrDimension(nCount,2,0,0,0)
For i=0 To nCount-1
tbl = cat.Tables(i)
lArray[i,0] = tbl.Name
lArray[i,1] = tbl.Type
Next
Return(lArray)
#EndFunction
cat = ObjectOpen("ADOX.Catalog")
;change the Source= to fir your own situation
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\WBDEMO\BLANK.MDB;"
Tbls = cat.Tables
nCount = Tbls.count()
aOle = GetTables(nCount,cat)
ObjectClose(cat)
For i=0 To nCount-1
message("Table %i%",strcat("NAME: ",aOle[i,0]," TYPE: ",aOle[i,1]) )
Next
exit
;================= End of Routine ======================================
;section5
; ///////////////////////////////////////////////////////
; Winbatch UDF to test impproved capabilities of the
; 2001 OLE Extender.
;
; The previous Extender had problems with Excel cells formatted
; as currency and date.
;
; Passing a cell to the UDF checks for these and formats accordingly
;
; Stan Littlefield 10/15/2000
; ///////////////////////////////////////////////////////
#DefineFunction GetValue(value,format)
Ret_Val = value
; determine if Cell Formated as Currency
If StrIndex(format,"$",1,@FWDSCAN) <> 0
Ret_Val = StrSub(value,11,-1)
Endif
; determine if Cell Formated as Date
If StrIndex(format,"yy",1,@FWDSCAN) <> 0
Ret_Val = Strcat( StrSub(value,6,2),"/",StrSub(value,9,2),"/",StrSub(value,1,4) )
Endif
Return(Ret_Val)
#EndFunction
;usage
; oCell = oWS.Cells(i,2)
; cFormat = oCell.NumberFormat
; cValue = GetValue( oCell.Value, cFormat )
;================= End of Routine ======================================
Article ID: W14996
File Created: 2001:11:08:12:41:20
Last Updated: 2001:11:08:12:41:20