Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.
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:18
Last Updated: 2001:11:08:12:41:18