This is a collection of UDF's that can be used to collect info into an Excel spreadsheet.

UDF's for:
  • Creating/opening closing sheets
  • Adding/deleting rows
  • Reading/writing cell values
  • Search a value in a given column
  • Sorting the data based on 1 - 3 columns, ascending/descending
  • Seting margins and paper orientation, create headerline
  • Format rows: Fontname, size and style
  • Format columns: Number,text,date
  • Create print headers and footers
  • Center print horizontally/vertically
In the included example i generate a sheet containing the size and free space for all servers in
a list. (If you use it from Win9x or NT you have to install WMI-Core)

To make this collection usefull/simple, i have had to break one of the golden rules for UDF´s
I use global variables [Embarrassed]

I cannot fit this in the UDF forum under the current rules, but maybe some of you can find it usefull.
I use it a lot myself when i generate statistics from my logon inventory where each client creates
an ini-file on a hidden share.

!!! OBS !!!
I have found out that the parameter sequence for sort is wrong in the VBA object viewer.
It says:
Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header)
Should be:
Sort(Key1, Order1, Type, Key2, Order2, Key3, Order3, Header)
The rearranged order of parameters is valid for Excel97/2002 (When accessed via COM)

File: xlUdf.udf
code:
Global $oXl,$xlRow,$SearcStartRow,$xlHeader ; Must be here for the functions to work !!!!!
 
; -------- ExCel UDF Section --------
 
; New WorkBook **************************************************************************
Function xlAddWorkBook(Optional $SheetName)
  $oXl = CreateObject("Excel.Application")
  $RC = $oXl.WorkBooks.Add(-4167) ; New workbook only 1 sheet
  If "$SheetName"
    $oXl.Sheets(1).Name = "$SheetName"
  EndIf
  $XlRow = 1 ; First empty row
  $SearcStartRow = 1
  $xlHeader = 2 ; No Header
EndFunction
 
 
Function xlWriteHeader($Header)
; If used, MUST be used just after xlAddWorkBook()
Dim $Col,$Field
  $Col = 1
  $xlRow = 2 ; First empty row
  $SearcStartRow = 2
  $xlHeader = 1 ; Yes, Header used in sheet
  For Each $Field In $Header
    $oXl.Cells(1,$Col).Value = $Field
    $Col = $Col + 1
  Next
  $RC = $oXl.Rows("1:1").Select
  $oXl.Selection.Font.Bold = -1
  $RC = $oXl.Rows("2:2").Select
  $oXl.ActiveWindow.FreezePanes = -1
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.PrintTitleRows = "$$1:$$1"
EndFunction
; End New WorkBook **********************************************************************
 
 
; Sheet functions ***********************************************************************
Function xlOpenWorkBook($FileName,Optional $HeaderLine)
  If "$HeaderLine"
    $xlRow = 2 ; First empty row
    $SearcStartRow = 2
    $xlHeader = 1 ; Yes
  Else
    $xlRow = 1 ; First empty row
    $SearcStartRow = 1
    $xlHeader = 2 ; No
  EndIf
  $oXl = CreateObject("Excel.Application")
  $RC = $oXl.Workbooks.Open($FileName)
EndFunction
 
 
Function xlSave($FileName)
  If Exist($FileName)
    $RC = $oXl.ActiveWorkbook.Save
  Else
    $RC = $oXl.ActiveWorkbook.SaveAs($FileName,-4143,"","",0,0,,,0)  ; xlWorkbookNormal = -4143
  EndIf
EndFunction
 
 
Function xlShow()
  $RC = $oXl.Range("A2").Select
  $oXl.Visible = -1
EndFunction
 
 
Function xlClose(Optional $Force)
  If $Force ; Close all Worksheets without saving, don't ask
    $oXl.DisplayAlerts = 0
  Else
    xlShow()
  EndIf
  $RC = $oXl.Quit
EndFunction
 
 
Function xlNumSheets()
; Returns number of sheets in active workbook
  $xlNumSheets = $oXl.ActiveWorkbook.Sheets.Count
EndFunction
 
 
Function xlSheetSelect($SheetNum)
; Returns name of selected sheet
  $RC = $oXl.ActiveWorkbook.Sheets($SheetNum).Select
  $xlSheetSelect = $oXl.ActiveWindow.ActiveSheet.Name
EndFunction
 
 
Function xlSort($ByCol1,Optional $Order1,Optional $ByCol2,Optional $Order2,Optional $ByCol3,Optional $Order3)
; $ByCol1 : Columnletter for first sort priority
; $Order1 : "A", 1 or nothing for ascending sort
;           "D" or 2 for descending sort
; $ByCol2 : Optional Columnletter for second sort priority
; $Order2 : See $Order1
; $ByCol3 : Optional Columnletter for third sort priority
; $Order3 : See $Order1
;
; Requires global parameter:
; $xlHeader = 1 ; Sheet has a header 1=Yes 2=No
  Dim $ParmOk,$SortStartRow
  If $xlHeader = 1
    $SortStartRow = '2'
  Else
    $SortStartRow = '1'
  EndIf
  $ParmOk = 1
  For $i = 1 To 3 ; Parameter check
    $RC = Execute("
    If '' + $$Order$i = ''
      $$Order$i = 1 ; Default sortorder, ascending
    Else
      Select
        Case $$Order$i = 'A'
          $$Order$i = 1
        Case $$Order$i = 'D'
          $$Order$i = 2
        Case $$Order$i <> 1 And $$Order$i <> 2 ; Illegal parameter
          $$ParmOk = 0
      EndSelect
    EndIf
    $$ByCol$i = $$ByCol$i + '$SortStartRow'
    ") ; End Execute
    If Not $ParmOk
      Return
    EndIf
  Next
  $RC = $oXl.Cells.Select
  If $ByCol2 <> $SortStartRow
    If $ByCol3 <> $SortStartRow
      $RC = $oXl.Selection.Sort($oXl.ActiveSheet.Range("$ByCol1"),$Order1,,
      $oXl.ActiveSheet.Range("$ByCol2"),$Order2,
      $oXl.ActiveSheet.Range("$ByCol3"),$Order3,$xlHeader)
    Else
      $RC = $oXl.Selection.Sort($oXl.ActiveSheet.Range("$ByCol1"),$Order1,,
      $oXl.ActiveSheet.Range("$ByCol2"),$Order2,,,$xlHeader)
    EndIf
  Else
    $RC = $oXl.Selection.Sort($oXl.ActiveSheet.Range("$ByCol1"),$Order1,,,,,,$xlHeader)
  EndIf
EndFunction
; End Sheet functions *******************************************************************
 
 
; Row/cell edit functions ***************************************************************
Function xlAddRow($RowArray)
; Global parameter $xlRow used for rownumber
  Dim $Col
  $Col = 1
  For Each $Field In $RowArray
    $oXl.Cells($xlRow,$Col).Value = $Field
    $Col = $Col + 1
  Next
  $XlRow = $XlRow + 1
EndFunction
 
 
Function xlDelRow($Row)
    $oXl.Rows("$Row:$Row").Select
    $oXl.Selection.Delete(-4162) ; Move up
EndFunction
 
 
Function xlFindValueRow($Col,$Value)
  ; Return row-number for match of value or first empty row
  Dim $Row
  $Row = $SearcStartRow
  $CellValue = $oXl.Cells($Row,$Col).Value
  While $CellValue <> $Value And $CellValue <> ''
    $Row = $Row + 1
    $CellValue = $oXl.Cells($Row,$Col).Value
  Loop
  If $CellValue = $Value
    $SearcStartRow = $Row + 1
  EndIf
  $xlFindValueRow = $Row
EndFunction
 
 
Function xlReadCellValue($Row,$Col)
  $xlReadCellValue = "" + $oXl.Cells($Row,$Col).Text
EndFunction
 
 
Function xlWriteCellValue($Row,$Col,$Value)
  $oXl.Cells($Row,$Col).Value = $Value
EndFunction
; End Row/cell edit functions ***********************************************************
 
 
; Format print, header/footer functions *************************************************
; Special formatting for Headers/footers
; &&; Write a single &-character.
; &"Fontname" (Fontname must be in doublequotes)
; &nn  nn = Fontsize. (Must be 2 long ie. fontsize 8 is &08)
; &B  Bold On/off
; &I  Italic On/off
; &U  Underline On/off
; &D  Date.
; &T  Time
; &F  Documentname.
; &P  Pagenumber.
; &N  Number of pages.
;
; Example ("Center footer: Page ? of ?? (Font Arial fontsize 8)):
; xlCenterFooter('&"Arial"&08Page &P of &N')
 
Function xlLeftHeader($HText)
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.LeftHeader = $HText
EndFunction
 
 
Function xlCenterHeader($HText)
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.CenterHeader = $HText
EndFunction
 
 
Function xlRightHeader($HText)
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.RightHeader = $HText
EndFunction
 
 
Function xlLeftFooter($HText)
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.LeftFooter = $HText
EndFunction
 
 
Function xlCenterFooter($HText)
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.CenterFooter = $HText
EndFunction
 
 
Function xlRightFooter($HText)
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.RightFooter = $HText
EndFunction
; End Format header functions ***********************************************************
 
 
; Format Sheet functions ****************************************************************
Function xlFontSize($Size)
  ; Should not be used after row-formattings
  $RC = $oXl.Cells.Select
  $oXl.Selection.Font.Size = $Size
EndFunction
 
 
Function xlFontName($FontName)
  ; Should not be used after row-formattings
  $RC = $oXl.Cells.Select
  $oXl.Selection.Font.Name = $FontName
EndFunction
 
 
Function xlAutoFit()
  $RC = $oXl.Cells.Select
  $RC = $oXl.Cells.EntireColumn.AutoFit
EndFunction
 
 
Function xlPrintGridlines(Optional $OnOff)
  ; $OnOff Values: 'On', 'Off'
  ; If omitted, 'On' is used
  If $OnOff = 'Off'
    $OnOff = 0
  Else
    $OnOff = 1
  EndIf
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.PrintGridlines = $OnOff
EndFunction
 
 
Function xlCenterHorizontally()
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.CenterHorizontally = -1
EndFunction
 
 
Function xlCenterVertically()
  $oXl.ActiveWorkbook.ActiveSheet.PageSetup.CenterVertically = -1
EndFunction
 
 
Function xlMargins($Left,$Right,$Top,$Bottom,$Header,$Footer,Optional $Orientation,Optional $Unit)
  If $Orientation = 'L' ; Pageorientation Landscape
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.Orientation = 2
  Else ; Pageorientation Portrait (Default)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.Orientation = 1
  EndIf
  If $Unit = 'I' ; Inches
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.LeftMargin = $oXl.InchesToPoints($Left)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.RightMargin = $oXl.InchesToPoints($Right)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.TopMargin = $oXl.InchesToPoints($Top)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.BottomMargin = $oXl.InchesToPoints($Bottom)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.HeaderMargin = $oXl.InchesToPoints($Header)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.FooterMargin = $oXl.InchesToPoints($Footer)
  Else ; Centimeters (Default)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.LeftMargin = $oXl.CentimetersToPoints($Left)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.RightMargin = $oXl.CentimetersToPoints($Right)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.TopMargin = $oXl.CentimetersToPoints($Top)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.BottomMargin = $oXl.CentimetersToPoints($Bottom)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.HeaderMargin = $oXl.CentimetersToPoints($Header)
    $oXl.ActiveWorkbook.ActiveSheet.PageSetup.FooterMargin = $oXl.CentimetersToPoints($Footer)
  EndIf
EndFunction
; End Format Sheet functions ************************************************************
 
 
; Format row functions ******************************************************************
Function xlRowFontSize($Row,$Size)
  $RC = $oXl.Rows("$Row:$Row").Select
  $oXl.Selection.Font.Size = $Size
EndFunction
 
 
Function xlRowFontName($Row,$FontName)
  $RC = $oXl.Rows("$Row:$Row").Select
  $oXl.Selection.Font.Name = $FontName
EndFunction
 
 
Function xlRowUnderline($Row,Optional $Style)
  ; $Style options: 'Off', 'Single', 'Double'
  ; If omittes, 'Single is used
  Select
    Case $Style = 'Off'
      $Style = -4142
    Case $Style = 'Double'
      $Style = -4119
    Case 1 ; 'Single'
      $Style = 2
  EndSelect
  $RC = $oXl.Rows("$Row:$Row").Select
  $oXl.Selection.Font.Underline = $Style
EndFunction
 
 
Function xlRowBold($Row,Optional $OnOff)
  ; $OnOff Values: 'On', 'Off'
  ; If omitted, 'On' is used
  If $OnOff = 'Off'
    $OnOff = 0
  Else
    $OnOff = 1
  EndIf
  $RC = $oXl.Rows("$Row:$Row").Select
  $oXl.Selection.Font.Bold = $OnOff
EndFunction
; End Format row functions **************************************************************
 
 
; Format column functions ***************************************************************
Function xlFormatColNumber($Column,Optional $Decimals,Optional $TSep)
  Dim $FmtStr
  $RC = $oXl.Columns("$Column:$Column").Select
  If Val('$Decimals') > 0
    $FmtStr = '0.'
    For $RC = 1 To Val('$Decimals')
      $FmtStr = $FmtStr + '0'
    Next
  Else
    $FmtStr = '0'
  EndIf
  If $TSep ; Use thousand separator
    $FmtStr = '#,##' + $FmtStr
  EndIf
  $oXl.Selection.NumberFormat = $FmtStr
EndFunction
 
 
Function xlFormatColDate($Column)
  $RC = $oXl.Columns("$Column:$Column").Select
  $oXl.Selection.NumberFormat = "yyyy/mm/dd"
EndFunction
 
 
Function xlFormatColText($Column)
  $RC = $oXl.Columns("$Column:$Column").Select
  $oXl.Selection.NumberFormat = '@@'
EndFunction
; End Format column functions ***********************************************************
Example use of xlUdf.udf
Create a list of disksize/freespace for servers
code:
Break On
 
Color w+/b
CLS
 
"Collecting information: Diskspace on servers" ?
 
$Servers = Split("Server1 Server2 Server3 ServerXX")
; !!!!!!!!!!!!  Change above line to the names of your servers !!!!!!!!!!!!
 
Call "xlUdf.udf"
 
If Exist(@CurDir + '\SrvDisk.xls')
  Del @CurDir + '\SrvDisk.xls'
EndIf
 
? "Creating SrvDisk.xls" ?
xlAddWorkBook("ServerDisks")
? "Ajusting margins and setting pageoriantation"
xlMargins(2, 2, 2.5, 2, 1, 1, 'P')
$Header = "Servers|Disk|Total MB|Free MB|Free %"
? "Writing columnheader"
xlWriteHeader(Split($Header,"|"))
? "Formatting column C as number (1 decimal, use thousand separator)"
xlFormatColNumber('C',1,1)
? "Formatting column D as number (1 decimal, don't use thousand separator)"
xlFormatColNumber('D',1)
? "Formatting column E as number" ?
xlFormatColNumber('E')
 
For Each $Srv In $Servers
  ? $Srv ?
  $objWMI = GetObject("winmgmts:{impersonationlevel=impersonate}!//" + $Srv)
  $colDisks = $objWMI.ExecQuery("Select * From win32_logicalDisk")
  For Each $objDisk In $colDisks
    If $objdisk.mediatype = 12
        Dim $Row[4]
        $Row[0] = $Srv
        $Row[1] = $objdisk.name
        $VolSize = $objDisk.size
        $Kb = CDbl($VolSize) / 1024
        $Row[2] = $Kb / 1024
        $FreeSpace = $objDisk.FreeSpace
        $Kb = CDbl($FreeSpace) / 1024
        $Row[3] = $Kb / 1024
        $Row[4] = CDbl($FreeSpace) * 100 / CDbl($VolSize) 
        xlAddRow($Row)
    EndIf
  Next
  $objWMI = 0
Next
 
? 'Formatting the sheet' ?
 
? "Print grid"
xlPrintGridlines()
 
? "Centering print horizontally"
xlCenterHorizontally()
 
? "Setting fontsize to 10"
xlFontSize(10)
 
? "Setting fontname to Times New Roman"
xlFontName("Times New Roman")
 
? "Adding center header: Diskinfo for servers"
? "      (Font: Arial 14 bold underlined)"
xlCenterHeader('&"Arial"&14&B&UDiskinfo for servers')
 
? "Adding center footer: Page ? of ?? (Font Arial 8)"
xlCenterFooter('&"Arial"&08Page &P of &N')
 
? "Adding right footer: Created: @Date"
xlRightFooter("Created @Date")
 
? "Ajusting columns"
xlAutoFit()
 
? "Sorting: column A descending, second sortorder column B ascending"
xlSort("A",2,"B")
 
? "Saving @CurDir\SrvDisk.xls"
xlSave('@CurDir\SrvDisk.xls')
 
xlShow()
 
$oXl = 0
 
Return
Where i haven't added a description for the function, i hope the function name is explanation enough. [Wink]
The output from the example should also give some hints.

Anyway i'm open for suggestions.

Of course you have to use KiX 4.+ but that shouldn't be nessasary to tell in this forum [Big Grin]

-Erik

ps.
Another reason for not submitting this in the UDF forum is that the error checking is very sparse.

[ 30. August 2002, 01:26: Message edited by: kholm ]