Scan text file listing for non-alphanumeric characters..........

TheMSsForum.com: The Microsoft Software Forum

The MSS Forum ‹ VBscripts
- Archive
  - Biz
  - MCSE
  - CRM
  - Drivers
  - Framework
  - ADO
  - ASP
  - Compact
  - Forms
  - Dotnet
  - C#
  - VB
  - FontpageGen
  - Excel
  - WorkSheet
  - Exchange
  - Setup
  - Fox
  - Fontpage
  - ASP
  - IIS
  - Entourage
  - Money
  - Messanger
  - PocketPC
  - Powerpoint
  - Project
  - Publisher
  - Excel
  - VB
  - Security
  - Portal
  - Services
  - SQLServerDev
  - SVCS
  - SQLServer
  - VB
  - VC
  - MFC
  - ExcelGen

- Previous
  - 1
    - German VBS Problem Hi, I have a problem with a German VB file which I am sure is related to the time and date format used in the UK dd.mm.yyyy If i sent my PC to location Germany then the code works. Can any help, here is the code '*************************************** '**** Author Eve '**** Swyx Communications AG '**** Import Call Detail Records '************************************** 'Version 1.03 'Public Const LOCALE_SSHORTDATE =3D &H1F Public Declare Function GetSystemDefaultLCID _ Lib "kernel32" () As Long Public Declare Function SetLocaleInfo _ Lib "kernel32" Alias "SetLocaleInfoA" ( _ ByVal Locale As Long, _ ByVal LCType As Long, _ ByVal lpLCData As String) As Boolean Public box3, box4_1, box4_0 As Variant '***********ADD IN********************** 'automated macro to make a new taskbar entry '*************************************** '#1 Sub Auto_open() Application.DisplayAlerts =3D False Dim ComBar As CommandBar On Error GoTo ErrLabel 'make a new taskbar entry "Call Detail Records 'with sub entries "Load Data" and "Save Data" Const MenueName =3D "Call Detail Records" 'count entries with name "Call Detail Records" Dim i i =3D 0 For Each ComBar In Application.CommandBars If ComBar.Name =3D "Call Detail Records" Then i =3D i + 1 End If Next 'if entry already existe, delete all entries If i > 0 Then ComBar.Delete Exit Sub i =3D 0 End If 'create new entry With Application.MenuBars(xlWorksheet) .Menus.Add Caption:=3DMenueName '.Menus(MenueName).MenuItems.Add Caption:=3D"Load CDR Version 3=2E20", OnAction:=3D"WarningMessageV3" .Menus(MenueName).MenuItems.Add Caption:=3D"Load CDR", OnAction:=3D"WarningMessageV4_0" '.Menus(MenueName).MenuItems.Add Caption:=3D"Load CDR Version 4=2E10", OnAction:=3D"WarningMessageV4_1" .Menus(MenueName).MenuItems.Add Caption:=3D"Save Data", OnAction:=3D"SaveData" End With 'delete 3rd worksheet Dim wkstemp Set wkstemp =3D Application.ActiveWorkbook.Worksheets(3) wkstemp.Select Application.DisplayAlerts =3D False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts =3D True ErrLabel: End Sub '****LOAD USERFORM********************** 'calls UserForm to choose the starting and finish date '*************************************** '#2 Sub LoadDialog_Load() LoadDialog.CalendarStart.value =3D Now LoadDialog.CalendarFinish.value =3D Now 'Ian Rowan LoadDialog.txtInputPathName.value =3D "\\avebury\swyx\" LoadDialog.Show End Sub '#4 Sub WarningMessageV4_0() box4_0 =3D 1 Call LoadDialog_Load End Sub '#5 Sub WarningMessageV4_1() box4_1 =3D 1 Call LoadDialog_Load End Sub '***********LOAD DATA******************* 'main macro to load and format the call detail records '*************************************** '#6 Sub LoadData() Application.DisplayAlerts =3D False Application.ScreenUpdating =3D False 'Show text of Label in Userform LoadDialog.Label5.Visible =3D True LoadDialog.Repaint '***********DECLARATION***************** '*************************************** 'worksheets Dim wks1 As Worksheet Dim wks2 As Worksheet Dim wks3 As Worksheet 'of columns of Origination Nr & Name, Destination Nr & Name 'Start Date & Time, End Date & Time, Duration (SumDif between Start time ' & end time), Currency, Costs, State, Public Access Prefix, Project Number, 'AOC for wks1 Dim xColOrigiNum& Dim xColOrigiName& Dim xColCalledNum& Dim xColCalledName& Dim xColDestNum& Dim xColDestName& Dim xColStartDate& Dim xColStartTime& Dim xColEndDate& Dim xColEndTime& Dim xColSumDif& Dim xColCurrency& Dim xColCosts& Dim xColState& Dim xColPAP& Dim xColLCR& Dim xColProjNum& Dim xColAOC& Dim xColOrigiDevice& Dim xColDestDevice& 'statistics Dim xColStatistics& '=3D xColOrigiNum& Dim xColStatistics2& Dim xColResults& '=3D xColOrigiName& Dim xColResultsInt2& Dim xColResultsExt2& Dim xRowStatistics& Dim xRowAllCalls& Dim xRowIntCalls& Dim xRowExtCalls& Dim xRowCosts& Dim xRowCostCalls& Dim xRowTime& Dim xRowDurCalls& Dim xRowStatus& Dim xRowExtConnected& Dim xRowExtAlerting& Dim xRowExtInit& Dim xRowExtHold& Dim xRowExtTransf& 'Time Per Call (=3D sumdiff ), Costs Per Name for wks2 Dim xColDestNum2& Dim xColDestName2& Dim xColStartDate2& Dim xColStartTime2& Dim xColTimePerCall& Dim xColCostsPerName& 'rows Dim xRowHeader& 'first row for header Dim xRowFirst& 'second row =3D first row to insert cdr Dim xRowLast& 'last written row Dim xRowTotal& 'row after xRowLast& to calculate total time and costs Dim xRowActive& 'current active row Dim xRowTemp& 'current caller name Dim xColOrigiNameValue As Variant 'results wks1 Dim xSumDif# Dim xTotalTime# Dim xTotalCosts# 'statistics wks1 Dim xAllCalls# Dim xDurCalls# Dim xIntCalls# Dim xExtCalls# Dim xCostCalls# Dim xExtConnected# Dim xExtAlerting# Dim xExtInit# Dim xExtHold# Dim xExtTransf# Dim xIntConnected# Dim xIntAlerting# Dim xIntInit# Dim xIntHold# Dim xIntTransf# Dim beginDate Dim endDate '***********INITIALIZATION************** '*************************************** 'Set fixed german date format for all date operations, 'since Swyx Server creates CDR files with fixed german 'date format ! ' Dim lngLocale As Long ' lngLocale =3D GetSystemDefaultLCID() 'bReturn =3D SetLocaleInfo(lngLocale, LOCALE_SSHORTDATE, "MM.dd.yyyy") 'initialize rows xRowHeader& =3D 1 xRowFirst& =3D 2 xRowTemp& =3D 2 'initialize columns for wks1 xColOrigiNum& =3D 1 xColOrigiName& =3D 2 xColOrigiDevice& =3D 3 xColCalledNum& =3D 4 xColCalledName& =3D 5 xColDestNum& =3D 6 xColDestName& =3D 7 xColDestDevice& =3D 8 xColStartDate& =3D 9 xColStartTime& =3D 10 xColEndDate& =3D 11 xColEndTime& =3D 12 xColSumDif& =3D 13 xColCurrency& =3D 14 xColCosts& =3D 15 xColState& =3D 16 xColPAP& =3D 17 xColLCR& =3D 18 xColProjNum& =3D 19 xColAOC& =3D 20 'Statistics xColStatistics& =3D 1 xColResults& =3D 2 xColStatistics2& =3D 4 xColResultsInt2& =3D 5 xColResultsExt2& =3D 6 'wks2 xColDestNum2& =3D 3 xColDestName2& =3D 4 xColStartDate2& =3D 5 xColStartTime2& =3D 6 xColTimePerCall& =3D 7 xColCostsPerName& =3D 8 'define workbook with its worksheets ActiveWorkbook.Author =3D "Eve*" Set wks1 =3D Application.ActiveWorkbook.Worksheets(1) Set wks2 =3D Application.ActiveWorkbook.Worksheets(2) Set wks3 =3D Application.ActiveWorkbook.Worksheets(3) wks1.Cells.Delete Shift:=3DxlUp wks2.Cells.Delete Shift:=3DxlUp wks3.Cells.Delete Shift:=3DxlUp 'format worksheets wks1.Name =3D "CDR Total" wks2.Name =3D "CDR per Name" wks3.Name =3D "Profile" wks1.Cells.NumberFormat =3D "General" wks2.Cells.NumberFormat =3D "General" wks3.Cells.NumberFormat =3D "General" 'format columns "@" =3D Stringformat wks1.Columns("A").NumberFormat =3D "@" wks1.Columns("B").NumberFormat =3D "@" wks1.Columns("C").NumberFormat =3D "@" wks1.Columns("D").NumberFormat =3D "@" wks1.Columns("E").NumberFormat =3D "@" wks1.Columns("F").NumberFormat =3D "@" wks1.Columns("G").NumberFormat =3D "@" wks1.Columns("H").NumberFormat =3D "@" wks1.Columns("N").NumberFormat =3D "@" wks1.Columns("O").NumberFormat =3D "@" wks2.Columns("A").NumberFormat =3D "@" wks2.Columns("B").NumberFormat =3D "@" wks2.Columns("C").NumberFormat =3D "@" wks2.Columns("D").NumberFormat =3D "@" 'clean up wks1 wks1.Select Selection.ClearContents Selection.ClearFormats 'get Value of DTPickers beginDate =3D LoadDialog.beginDate endDate =3D LoadDialog.endDate '***********SEARCH IN TEXTFILE********** '*************************************** 'Declaration Dim curPath$ Dim xCount& Dim i& Dim Filename$ Dim Titelline$ Dim TokensTemp As Variant Dim compareToken Dim compareTokenV3x Dim compareTokenV40 Dim compareTokenV41 Dim Titleline Dim DataLine$ Dim Tokens As Variant Dim TempOrigiNum Dim TempOrigiName Dim TempCalledNum Dim TempCalledName Dim TempDestNum Dim TempDestName Dim TempStartDate Dim TempStartTime Dim TempEndDate Dim TempEndTime Dim TempCurrency Dim TempCosts Dim TempState Dim TempPAP Dim TempLCR Dim TempProjNum Dim TempAOC Dim TempOrigiDevice Dim TempDestDevice Dim fs Dim myfile 'As Scripting.File Dim myfilestream 'As Scripting.TextStream Dim value, delta, flag, count, startminuten, stopminuten 'get current pathname from textbox curPath$ =3D LoadDialog.curPath 'Have to change the path Application.FileSearch.LookIn =3D curPath$ Application.FileSearch.Filename =3D "*.txt" Application.FileSearch.FileType =3D msoFileTypeAllFiles Application.FileSearch.Execute 'Number of files in the directory xCount& =3D Application.FileSearch.FoundFiles.count '#7 'for each file For i =3D 1 To xCount& On Error GoTo 100 Filename =3D Application.FileSearch.FoundFiles.Item(i) Set fs =3D CreateObject("Scripting.FileSystemObject") Set myfile =3D fs.GetFile(Filename) Set myfilestream =3D myfile.OpenAsTextStream(1, -2) 'ingore first line with titles Titleline =3D myfilestream.ReadLine TokensTemp =3D Split(Titleline, """") If InStr(Titleline, "IpPbxSrv") > 0 Then Titleline =3D myfilestream.ReadLine TokensTemp =3D Split(Titleline, """") End If If UBound(TokensTemp) > 0 Then compareToken =3D TokensTemp(1) compareTokenV40 =3D "OriginationNumber" 'version 4.0 compareTokenV41 =3D "CallID" 'version 4.10 '#8 Check if csv entry is for version 4.0 If StrComp(compareToken, compareTokenV40, vbTextCompare) =3D 0 And StrComp(compareTokenV3x, compareTokenV40, vbTextCompare) =3D 0 Then Do LoadDialog.MousePointer =3D fmMousePointerHourGlass 'read line 'this is the first data line DataLine =3D myfilestream.ReadLine Tokens =3D Split(DataLine, """") 'take the tokens for each cell in the excelsheet TempOrigiNum =3D Tokens(1) TempOrigiName =3D Tokens(3) TempCalledNum =3D Tokens(5) TempCalledName =3D Tokens(7) TempDestNum =3D Tokens(9) TempDestName =3D Tokens(11) TempStartDate =3D Tokens(13) TempStartTime =3D Tokens(15) TempEndDate =3D Tokens(17) TempEndTime =3D Tokens(19) TempCurrency =3D Tokens(21) TempCosts =3D Tokens(23) TempState =3D Tokens(25) TempPAP =3D Tokens(27) TempLCR =3D Tokens(29) TempProjNum =3D Tokens(31) TempAOC =3D Tokens(33) TempOrigiDevice =3D Tokens(35) TempDestDevice =3D Tokens(37) '#9 proof if date is valid If CDate(TempStartDate) >=3D CDate(beginDate) And CDate(TempStartDate) <=3D CDate(endDate) Then 'insert tokens in the cell of the excelsheet wks1.Cells(xRowTemp&, xColOrigiNum&).value =3D CStr(TempOrigiNum) wks1.Cells(xRowTemp&, xColOrigiName&).value =3D CVar(TempOrigiName) wks1.Cells(xRowTemp&, xColOrigiDevice&).value =3D CVar(TempOrigiDevice) wks1.Cells(xRowTemp&, xColCalledNum&).value =3D CStr(TempCalledNum) wks1.Cells(xRowTemp&, xColCalledName&).value =3D CVar(TempCalledName) wks1.Cells(xRowTemp&, xColDestNum&).value =3D CStr(TempDestNum) wks1.Cells(xRowTemp&, xColDestName&).value =3D CVar(TempDestName) wks1.Cells(xRowTemp&, xColDestDevice&).value =3D CVar(TempDestDevice) wks1.Cells(xRowTemp&, xColStartDate&).value =3D CDate(TempStartDate) wks1.Cells(xRowTemp&, xColStartTime&).value =3D CDate(TempStartTime) wks1.Cells(xRowTemp&, xColEndDate&).value =3D CDate(TempEndDate) wks1.Cells(xRowTemp&, xColEndTime&).value =3D CDate(TempEndTime) wks1.Cells(xRowTemp&, xColCurrency&).value =3D CStr(TempCurrency) wks1.Cells(xRowTemp&, xColCosts&).value =3D CDbl(TempCosts) / 100 wks1.Cells(xRowTemp&, xColState&).value =3D CVar(TempState) wks1.Cells(xRowTemp&, xColPAP&).value =3D CVar(TempPAP) wks1.Cells(xRowTemp&, xColLCR&).value =3D CVar(TempLCR) wks1.Cells(xRowTemp&, xColProjNum&).value =3D CVar(TempProjNum) wks1.Cells(xRowTemp&, xColAOC&).value =3D CVar(TempAOC) xRowTemp& =3D xRowTemp& + 1 End If 'get next file if found end of file If myfilestream.AtEndOfStream =3D True Then Exit Do End If '#9 proof if date is valid Loop While CDate(TempStartDate) <=3D CDate(endDate) End If '#10 Check if csv entry is for version 4.10 If StrComp(compareToken, compareTokenV41, vbTextCompare) =3D 0 Then 'Call LoadData4_1 'Exit Sub Do LoadDialog.MousePointer =3D fmMousePointerHourGlass 'read line 'this is the first data line DataLine =3D myfilestream.ReadLine Tokens =3D Split(DataLine, """") 'take the tokens for each cell in the excelsheet TempOrigiNum =3D Tokens(3) TempOrigiName =3D Tokens(5) TempCalledNum =3D Tokens(7) TempCalledName =3D Tokens(9) TempDestNum =3D Tokens(11) TempDestName =3D Tokens(13) TempStartDate =3D Tokens(15) TempStartTime =3D Tokens(17) TempEndDate =3D Tokens(31) TempEndTime =3D Tokens(33) TempCurrency =3D Tokens(35) TempCosts =3D Tokens(37) TempState =3D Tokens(39) TempPAP =3D Tokens(41) TempLCR =3D Tokens(43) TempProjNum =3D Tokens(45) TempAOC =3D Tokens(47) TempOrigiDevice =3D Tokens(49) TempDestDevice =3D Tokens(51) '#9 proof if date is valid If CDate(TempStartDate) >=3D CDate(beginDate) And CDate(TempStartDate) <=3D CDate(endDate) Then 'insert tokens in the cell of the excelsheet wks1.Cells(xRowTemp&, xColOrigiNum&).value =3D CStr(TempOrigiNum) wks1.Cells(xRowTemp&, xColOrigiName&).value =3D CVar(TempOrigiName) wks1.Cells(xRowTemp&, xColOrigiDevice&).value =3D CVar(TempOrigiDevice) wks1.Cells(xRowTemp&, xColCalledNum&).value =3D CStr(TempCalledNum) wks1.Cells(xRowTemp&, xColCalledName&).value =3D CVar(TempCalledName) wks1.Cells(xRowTemp&, xColDestNum&).value =3D CStr(TempDestNum) wks1.Cells(xRowTemp&, xColDestName&).value =3D CVar(TempDestName) wks1.Cells(xRowTemp&, xColDestDevice&).value =3D CVar(TempDestDevice) wks1.Cells(xRowTemp&, xColStartDate&).value =3D CDate(TempStartDate) wks1.Cells(xRowTemp&, xColStartTime&).value =3D CDate(TempStartTime) wks1.Cells(xRowTemp&, xColEndDate&).value =3D CDate(TempEndDate) wks1.Cells(xRowTemp&, xColEndTime&).value =3D CDate(TempEndTime) wks1.Cells(xRowTemp&, xColCurrency&).value =3D CStr(TempCurrency) wks1.Cells(xRowTemp&, xColCosts&).value =3D CDbl(TempCosts) / 100 wks1.Cells(xRowTemp&, xColState&).value =3D CVar(TempState) wks1.Cells(xRowTemp&, xColPAP&).value =3D CVar(TempPAP) wks1.Cells(xRowTemp&, xColLCR&).value =3D CVar(TempLCR) wks1.Cells(xRowTemp&, xColProjNum&).value =3D CVar(TempProjNum) wks1.Cells(xRowTemp&, xColAOC&).value =3D CVar(TempAOC) xRowTemp& =3D xRowTemp& + 1 End If 'get next file if found end of file If myfilestream.AtEndOfStream =3D True Then Exit Do End If '#9 proof if date is valid Loop While CDate(TempStartDate) <=3D CDate(endDate) End If End If Next 100: On Error Resume Next '************** FORMAT WORKSHEET 1 ***** '*************************************** '#11 define value of headers wks1.Cells(xRowHeader&, xColOrigiNum&).value =3D "Caller, Number" wks1.Cells(xRowHeader&, xColOrigiName&).value =3D "Caller, Name" wks1.Cells(xRowHeader&, xColOrigiDevice&).value =3D "Caller, Device" wks1.Cells(xRowHeader&, xColCalledNum&).value =3D "Called, Number" wks1.Cells(xRowHeader&, xColCalledName&).value =3D "Called, Name" wks1.Cells(xRowHeader&, xColDestNum&).value =3D "Destination, Number" wks1.Cells(xRowHeader&, xColDestName&).value =3D "Destination, Name" wks1.Cells(xRowHeader&, xColDestDevice&).value =3D "Destination, Device" wks1.Cells(xRowHeader&, xColStartDate&).value =3D "Starting Date" wks1.Cells(xRowHeader&, xColStartTime&).value =3D "Starting Time" wks1.Cells(xRowHeader&, xColEndDate&).value =3D "Finish Date" wks1.Cells(xRowHeader&, xColEndTime&).value =3D "Finish Time" wks1.Cells(xRowHeader&, xColSumDif&).value =3D "Duration" wks1.Cells(xRowHeader&, xColCurrency&).value =3D "Currency" wks1.Cells(xRowHeader&, xColCosts&).value =3D "Costs" wks1.Cells(xRowHeader&, xColState&).value =3D "State" wks1.Cells(xRowHeader&, xColPAP&).value =3D "PAP" wks1.Cells(xRowHeader&, xColLCR&).value =3D "Provider" wks1.Cells(xRowHeader&, xColProjNum&).value =3D "Project" wks1.Cells(xRowHeader&, xColAOC&).value =3D "AOC" 'define format wks1.Columns("A").NumberFormat =3D "@" wks1.Columns("B").NumberFormat =3D "@" wks1.Columns("C").NumberFormat =3D "@" wks1.Columns("D").NumberFormat =3D "@" wks1.Columns("E").NumberFormat =3D "@" wks1.Columns("F").NumberFormat =3D "@" wks1.Columns("G").NumberFormat =3D "@" wks1.Columns("H").NumberFormat =3D "@" wks1.Columns("I").NumberFormat =3D "dd/mm/yyyy" wks1.Columns("J").NumberFormat =3D "hh:mm:ss" wks1.Columns("K").NumberFormat =3D "dd/mm/yyyy" wks1.Columns("L").NumberFormat =3D "hh:mm:ss" wks1.Columns("M").NumberFormat =3D "hh:mm:ss" wks1.Columns("N").NumberFormat =3D "@" wks1.Columns("O").NumberFormat =3D "#,##0.00" '#12 Error message: if first value of csv is 0 If wks1.Cells(2, 2).value =3D 0 Then Dim tempbox tempbox =3D MsgBox("No data was found with the given date." & _ "Please verify your selection!", vbOKOnly, "Error occured") LoadDialog.Hide LoadDialog.MousePointer =3D fmMousePointerArrow Exit Sub End If 'format worksheet1 wks1.Activate wks1.Cells(1, 1).Select ActiveCell.CurrentRegion.Select '#13 format headers bold and align middle Selection.AutoFormat Format:=3DxlRangeAutoFormatSimple, Number:=3DTrue, Font _ :=3DTrue, Alignment:=3DTrue, Border:=3DTrue, Pattern:=3DTrue, Width:=3DTrue 'sort in alphabetical order Selection.Sort key1:=3DCells(xRowFirst&, xColOrigiNum&), Order1:=3DxlAscending, Header:=3DxlYes, _ OrderCustom:=3D1, MatchCase:=3DFalse, Orientation:=3DxlTopToBottom 'allow word-wrap With Selection .VerticalAlignment =3D xlBottom .WrapText =3D True .Orientation =3D 0 .AddIndent =3D False .ShrinkToFit =3D False .MergeCells =3D False End With 'freeze the headers, so you always see them while scrolling Rows("2:2").Select ActiveWindow.FreezePanes =3D True 'Change caption of Label in the dialog LoadDialog.Label5.Caption =3D "..... processing ....." LoadDialog.Repaint '**CALCULATE TOTAL TIME, WORKSHEET 1 AND WORKSHEET 2*** '******************************************************* 'count till last row xRowLast& =3D wks1.Cells(wks1.Rows.count, xColEndTime&).End(xlUp).Row xRowTotal& =3D xRowLast& + 1 'last active row + 1 - to show total result 'current active row For xRowActive& =3D xRowFirst& To xRowLast& '#14 calculate xSumDif# 'proof valid cdr entry If wks1.Cells(xRowActive&, xColStartTime&).value <=3D wks1.Cells(xRowActive&, xColEndTime&).value Then xSumDif# =3D wks1.Cells(xRowActive&, xColEndTime&).value - wks1.Cells(xRowActive&, xColStartTime&).value 'xSumDif# for worksheet1 wks1.Cells(xRowActive&, xColSumDif&).NumberFormat =3D "[hh]:mm:ss" wks1.Cells(xRowActive&, xColSumDif&).FormulaR1C1 =3D CDate(xSumDif#) 'xSumDif# for worksheet2 wks2.Cells(xRowActive&, xColTimePerCall&).NumberFormat =3D "[hh]:mm:ss" wks2.Cells(xRowActive&, xColTimePerCall&).FormulaR1C1 =3D CDate(xSumDif#) xTotalTime# =3D xTotalTime# + xSumDif# xTotalCosts# =3D xTotalCosts# + CDec(wks1.Cells(xRowActive&, xColCosts&).value) Else 'if time value is not valid xSumDif# =3D 0 Dim box 'box =3D MsgBox("Please verify the original cdr file." & Chr(10) & "The end of the call is dated before the starting time." _ '& Chr(10) & "The error occured in line: " & xRowActive&, 48, "Warning: Wrong time") wks1.Cells(xRowActive&, xColSumDif&).value =3D "Error" End If '#15 internal or external call? If wks1.Cells(xRowActive&, xColAOC&).value =3D "1" Then xExtCalls# =3D xExtCalls# + 1 'iterate external calls End If 'which state 'connected If wks1.Cells(xRowActive&, xColState&).value =3D "Connected" Then If wks1.Cells(xRowActive&, xColAOC&).value =3D "1" Then xExtConnected# =3D xExtConnected# + 1 'iterate external calls with state "connected" Else xIntConnected# =3D xIntConnected# + 1 End If End If 'calling If wks1.Cells(xRowActive&, xColState&).value =3D "Alerting" Then If wks1.Cells(xRowActive&, xColAOC&).value =3D "1" Then xExtAlerting# =3D xExtAlerting# + 1 'iterate external calls with state "calling" Else xIntAlerting# =3D xIntAlerting# + 1 End If End If 'initialized If wks1.Cells(xRowActive&, xColState&).value =3D "Initialized" Then If wks1.Cells(xRowActive&, xColAOC&).value =3D "1" Then xExtInit# =3D xExtInit# + 1 'iterate external calls with state "initialized" Else xIntInit# =3D xIntInit# + 1 End If End If 'holding If wks1.Cells(xRowActive&, xColState&).value =3D "On hold" Then If wks1.Cells(xRowActive&, xColAOC&).value =3D "1" Then xExtHold# =3D xExtHold# + 1 'iterate external calls with state "holding" Else xIntHold# =3D xIntHold# + 1 End If End If 'transferring If wks1.Cells(xRowActive&, xColState&).value =3D "Transferred" Then If wks1.Cells(xRowActive&, xColAOC&).value =3D "1" Then xExtTransf# =3D xExtTransf# + 1 'iterate external calls with state "holding" Else xIntTransf# =3D xIntTransf# + 1 End If End If Next '#16 format total costs wks1.Cells(xRowTotal&, xColCosts&).NumberFormat =3D "#,##0.00" wks1.Cells(xRowTotal&, xColCosts&).Font.Bold =3D True wks1.Cells(xRowTotal&, xColCosts&).EntireColumn.AutoFit wks1.Cells(xRowTotal&, xColCosts&).value =3D CDec(xTotalCosts#) 'format total time wks1.Cells(xRowTotal&, xColSumDif&).NumberFormat =3D "[hh]:mm:ss" wks1.Cells(xRowTotal&, xColSumDif&).Font.Bold =3D True wks1.Cells(xRowTotal&, xColSumDif&).EntireColumn.AutoFit wks1.Cells(xRowTotal&, xColSumDif&).value =3D CDec(xTotalTime#) '#17 calculate nr of all calls, average duration, all external calls and 'average costs xAllCalls# =3D xRowLast& - 1 xIntCalls# =3D xAllCalls# - xExtCalls# 'avoid a zero-devision If xExtConnected# <> 0 Then xCostCalls# =3D xTotalCosts# / xExtConnected# Else xCostCalls# =3D 0 End If 'avoid a zero-devision If xAllCalls# <> 0 Then xDurCalls# =3D xTotalTime# / xAllCalls# Else xDurCalls# =3D 0 End If '#18 row position for statistics xRowStatistics& =3D xRowTotal& + 2 xRowAllCalls& =3D xRowTotal& + 3 xRowIntCalls& =3D xRowTotal& + 4 xRowExtCalls& =3D xRowTotal& + 5 xRowCosts& =3D xRowTotal& + 6 xRowCostCalls& =3D xRowTotal& + 7 xRowTime& =3D xRowTotal& + 8 xRowDurCalls& =3D xRowTotal& + 9 xRowStatus& =3D xRowTotal& + 3 xRowExtConnected& =3D xRowTotal& + 4 xRowExtAlerting& =3D xRowTotal& + 5 xRowExtInit& =3D xRowTotal& + 6 xRowExtHold& =3D xRowTotal& + 7 xRowExtTransf& =3D xRowTotal + 8 'format font wks1.Range(Cells(xRowStatistics&, xColStatistics&), Cells(xRowDurCalls&, xColStatistics&)).Font.Bold =3D True wks1.Range(Cells(xRowStatistics&, xColStatistics2&), Cells(xRowExtTransf&, xColStatistics2&)).Font.Bold =3D True 'header for statistics wks1.Cells(xRowStatistics&, xColStatistics&).value =3D "Statistics:" wks1.Cells(xRowAllCalls&, xColStatistics&).value =3D "All Calls:" wks1.Cells(xRowIntCalls&, xColStatistics&).value =3D "Internal Calls:" wks1.Cells(xRowExtCalls&, xColStatistics&).value =3D "External Calls:" wks1.Cells(xRowCosts&, xColStatistics&).value =3D "Total Costs:" 'wks1.Cells(xRowCostCalls&, xColStatistics&).value =3D Chr(216) & " Costs:" wks1.Cells(xRowCostCalls&, xColStatistics&).value =3D " Costs:" wks1.Cells(xRowTime&, xColStatistics&).value =3D "Total Time:" 'wks1.Cells(xRowDurCalls&, xColStatistics&).value =3D Chr(216) & " Duration:" wks1.Cells(xRowDurCalls&, xColStatistics&).value =3D " Duration:" wks1.Cells(xRowStatistics&, xColStatistics2&).value =3D "Statistics:" wks1.Cells(xRowStatus&, xColStatistics2&).value =3D "Status:" wks1.Cells(xRowExtConnected&, xColStatistics2&).value =3D "Connected:" wks1.Cells(xRowExtAlerting&, xColStatistics2&).value =3D "Alerting:" wks1.Cells(xRowExtInit&, xColStatistics2&).value =3D "Initialized:" wks1.Cells(xRowExtHold&, xColStatistics2&).value =3D "Holding:" wks1.Cells(xRowExtTransf&, xColStatistics2&).value =3D "Transferred:" wks1.Cells(xRowStatus&, xColResultsInt2&).value =3D "Internal" wks1.Cells(xRowStatus&, xColResultsExt2&).value =3D "External" 'show results wks1.Cells(xRowAllCalls&, xColResults&).value =3D xAllCalls# wks1.Cells(xRowIntCalls&, xColResults&).value =3D xIntCalls# wks1.Cells(xRowExtCalls&, xColResults&).value =3D xExtCalls# wks1.Cells(xRowCosts&, xColResults&).value =3D xTotalCosts# wks1.Cells(xRowCostCalls&, xColResults&).value =3D xCostCalls# wks1.Cells(xRowTime&, xColResults&).value =3D xTotalTime# wks1.Cells(xRowDurCalls&, xColResults&).value =3D xDurCalls# wks1.Cells(xRowExtConnected&, xColResultsExt2&).value =3D xExtConnected# wks1.Cells(xRowExtAlerting&, xColResultsExt2&).value =3D xExtAlerting# wks1.Cells(xRowExtInit&, xColResultsExt2&).value =3D xExtInit# wks1.Cells(xRowExtHold&, xColResultsExt2&).value =3D xExtHold# wks1.Cells(xRowExtTransf&, xColResultsExt2&).value =3D xExtTransf# wks1.Cells(xRowExtConnected&, xColResultsInt2&).value =3D xIntConnected# wks1.Cells(xRowExtAlerting&, xColResultsInt2&).value =3D xIntAlerting# wks1.Cells(xRowExtInit&, xColResultsInt2&).value =3D xIntInit# wks1.Cells(xRowExtHold&, xColResultsInt2&).value =3D xIntHold# wks1.Cells(xRowExtTransf&, xColResultsInt2&).value =3D xIntTransf# 'format results wks1.Cells(xRowCosts&, xColResults&).NumberFormat =3D "#,##0.00" wks1.Cells(xRowCostCalls&, xColResults&).NumberFormat =3D "#,##0.00" wks1.Cells(xRowTime&, xColResults&).NumberFormat =3D "[hh]:mm:ss" wks1.Cells(xRowDurCalls&, xColResults&).NumberFormat =3D "[hh]:mm:ss" 'format statistics Range(Cells(xRowStatistics&, xColStatistics&), Cells(xRowDurCalls&, xColResults&)).Select Selection.Borders(xlDiagonalDown).LineStyle =3D xlNone Selection.Borders(xlDiagonalUp).LineStyle =3D xlNone With Selection.Borders(xlEdgeLeft) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With Selection.Borders(xlInsideVertical).LineStyle =3D xlNone Selection.Borders(xlInsideHorizontal).LineStyle =3D xlNone 'format statistics Range(Cells(xRowStatistics&, xColStatistics2&), Cells(xRowExtTransf&, xColResultsExt2&)).Select Selection.Borders(xlDiagonalDown).LineStyle =3D xlNone Selection.Borders(xlDiagonalUp).LineStyle =3D xlNone With Selection.Borders(xlEdgeLeft) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle =3D xlContinuous .Weight =3D xlMedium .ColorIndex =3D xlAutomatic End With Selection.Borders(xlInsideVertical).LineStyle =3D xlNone Selection.Borders(xlInsideHorizontal).LineStyle =3D xlNone '****FORMAT HEADER OF WORKSHEET 2 ***** '************************************** '#19 'define headers wks2.Cells(xRowHeader&, xColOrigiNum&).value =3D "Caller, Name" wks2.Cells(xRowHeader&, xColOrigiName&).value =3D "Caller, Number" wks2.Cells(xRowHeader&, xColDestNum2&).value =3D "Destination, Name" wks2.Cells(xRowHeader&, xColDestName2&).value =3D "Destination, Number" wks2.Cells(xRowHeader&, xColStartDate2&).value =3D "Starting Date" wks2.Cells(xRowHeader&, xColStartTime2&).value =3D "Starting Time" wks2.Cells(xRowHeader&, xColTimePerCall&).value =3D "Duration" wks2.Cells(xRowHeader&, xColCostsPerName&).value =3D "Costs per Name" 'format headers wks2.Columns(1).NumberFormat =3D "@" wks2.Columns(2).NumberFormat =3D "@" wks2.Columns(3).NumberFormat =3D "@" wks2.Columns(4).NumberFormat =3D "@" wks2.Columns(5).NumberFormat =3D "dd/mm/yyyy" wks2.Columns(6).NumberFormat =3D "[hh]:mm:ss" wks2.Columns(7).NumberFormat =3D "[hh]:mm:ss" wks2.Columns(8).NumberFormat =3D "#,##0.00" '***** GET DATA FROM WORKSHEET 1 ****** '**********TO WORKSHEET 3 ************* '************************************** '#20 'active rows value =3D 0 delta =3D 30 ' alle 30 minuten xRowActive& =3D 2 For value =3D 0 To 24 * 60 Step delta wks3.Cells(xRowActive&, 1).value =3D value wks3.Cells(xRowActive&, 2).value =3D TimeSerial(0, value, 0) wks3.Cells(xRowActive&, 3).value =3D 0 xRowActive& =3D xRowActive& + 1 Next Sheets("Profile").Select Columns("B:B").Select Selection.NumberFormat =3D "h:mm;@" For xRowActive& =3D xRowFirst& To xRowLast& startminuten =3D Hour(wks1.Cells(xRowActive&, xColStartTime&).value) * 60 + Minute(wks1.Cells(xRowActive&, xColStartTime&).value) stopminuten =3D Hour(wks1.Cells(xRowActive&, xColEndTime&).value) * 60 + Minute(wks1.Cells(xRowActive&, xColEndTime&).value) flag =3D 0 count =3D 2 For value =3D 0 To 24 * 60 - 1 Step delta If value <=3D stopminuten And flag =3D 1 Then wks3.Cells(count, 3).value =3D wks3.Cells(count, 3).value + 1 End If If value >=3D startminuten And flag =3D 0 Then wks3.Cells(count, 3).value =3D wks3.Cells(count, 3).value + 1 flag =3D 1 End If count =3D count + 1 Next Next For count =3D 1 To 7 Step 1 wks3.Cells(count + 1, 4).value =3D WeekdayName(count) Next wks3.Cells(1, 5).value =3D "external" wks3.Cells(1, 6).value =3D "internal" For xRowActive& =3D xRowFirst& To xRowLast& If wks1.Cells(xRowActive&, xColState&).value =3D "Connected" Then If wks1.Cells(xRowActive&, xColAOC&).value =3D "1" Then 'iterate external calls startminuten =3D Weekday(wks1.Cells(xRowActive&, xColStartDate&).value, 2) wks3.Cells(startminuten + 1, 5).value =3D wks3.Cells(startminuten + 1, 5).value + 1 Else 'iterate internal calls startminuten =3D Weekday(wks1.Cells(xRowActive&, xColStartDate&).value, 2) wks3.Cells(startminuten + 1, 6).value =3D wks3.Cells(startminuten + 1, 6).value + 1 End If End If Next ' ' Makro2 Makro ' Makro am 30.12.2002 von Uwe Sauerbrey aufgezeichnet ' ' Charts.Add ActiveChart.ChartType =3D xlColumnClustered ActiveChart.SetSourceData Source:=3DSheets("Profile").Range("B2:C49"), PlotBy:=3DxlColumns ActiveChart.Location Where:=3DxlLocationAsObject, Name:=3D"Profile" With ActiveChart .HasTitle =3D True .ChartTitle.Characters.text =3D "Calls during 24h" .Axes(xlCategory, xlPrimary).HasTitle =3D False .Axes(xlValue, xlPrimary).HasTitle =3D True .Axes(xlValue, xlPrimary).AxisTitle.Characters.text =3D "calls" End With With ActiveChart.Axes(xlCategory) .HasMajorGridlines =3D False .HasMinorGridlines =3D False End With With ActiveChart.Axes(xlValue) .HasMajorGridlines =3D True .HasMinorGridlines =3D False End With ActiveChart.HasLegend =3D False ActiveChart.HasDataTable =3D False ActiveChart.Axes(xlCategory).Select With ActiveChart.Axes(xlCategory) .CrossesAt =3D 1 .TickLabelSpacing =3D 2 .TickMarkSpacing =3D 1 .AxisBetweenCategories =3D True .ReversePlotOrder =3D False End With With Selection.TickLabels .Alignment =3D xlCenter .Offset =3D 100 .ReadingOrder =3D xlContext .Orientation =3D xlUpward End With Charts.Add ActiveChart.ChartType =3D xlColumnClustered ActiveChart.SetSourceData Source:=3DSheets("Profile").Range("D1:F8"), PlotBy:=3DxlColumns ActiveChart.Location Where:=3DxlLocationAsObject, Name:=3D"Profile" With ActiveChart .HasTitle =3D True .ChartTitle.Characters.text =3D "Calls during the week" .Axes(xlCategory, xlPrimary).HasTitle =3D False .Axes(xlValue, xlPrimary).HasTitle =3D True .Axes(xlValue, xlPrimary).AxisTitle.Characters.text =3D "calls" End With With ActiveChart.Axes(xlCategory) .HasMajorGridlines =3D False .HasMinorGridlines =3D False End With With ActiveChart.Axes(xlValue) .HasMajorGridlines =3D True .HasMinorGridlines =3D False End With ActiveChart.HasLegend =3D False ActiveChart.HasDataTable =3D False ActiveChart.Axes(xlCategory).Select With ActiveChart.Axes(xlCategory) .CrossesAt =3D 1 .TickLabelSpacing =3D 2 .TickMarkSpacing =3D 1 .AxisBetweenCategories =3D True .ReversePlotOrder =3D False End With With Selection.TickLabels .Alignment =3D xlCenter .Offset =3D 100 .ReadingOrder =3D xlContext .Orientation =3D xlUpward End With With ActiveChart.Axes(xlCategory) .CrossesAt =3D 1 .TickLabelSpacing =3D 1 .TickMarkSpacing =3D 1 .AxisBetweenCategories =3D True .ReversePlotOrder =3D False End With ActiveChart.ChartArea.Select ActiveChart.HasLegend =3D True ActiveChart.Legend.Select Selection.Position =3D xlRight ActiveChart.ChartArea.Select ActiveSheet.Shapes("Diagramm 2").IncrementLeft -174.75 ActiveSheet.Shapes("Diagramm 2").IncrementTop -96.75 '***** GET DATA FROM WORKSHEET 1 ****** '**********TO WORKSHEET 2 ************* '************************************** '#20 'active rows For xRowActive& =3D xRowFirst& To xRowLast& 'data from wks1 to wks2 wks2.Cells(xRowActive&, xColOrigiNum&).value =3D wks1.Cells(xRowActive&, xColOrigiName&).value wks2.Cells(xRowActive&, xColOrigiName&).value =3D wks1.Cells(xRowActive&, xColOrigiNum&).value wks2.Cells(xRowActive&, xColDestNum2&).value =3D wks1.Cells(xRowActive&, xColDestName&).value wks2.Cells(xRowActive&, xColDestName2&).value =3D wks1.Cells(xRowActive&, xColDestNum&).value wks2.Cells(xRowActive&, xColStartDate2&).value =3D wks1.Cells(xRowActive&, xColStartDate&).value wks2.Cells(xRowActive&, xColStartTime2&).value =3D wks1.Cells(xRowActive&, xColStartTime&).value 'take next caller name? If Not xColOrigiNameValue =3D wks2.Cells(xRowActive&, xColOrigiNum&).value Then 'still same caller name xColOrigiNameValue =3D wks2.Cells(xRowActive&, xColOrigiNum&).value End If 'costs wks2.Cells(xRowActive&, xColCostsPerName&).NumberFormat =3D "#,##0.00" wks2.Cells(xRowActive&, xColCostsPerName&).value =3D wks1.Cells(xRowActive&, xColCosts&).value Next '***** FORMAT DATA OF WORKSHEET 2 ***** '************************************** '#21 wks2.Activate wks2.Cells(1, 1).Select ActiveCell.CurrentRegion.Select 'format headers bold and align middle Selection.AutoFormat Format:=3DxlRangeAutoFormatSimple, Number:=3DTrue, Font _ :=3DTrue, Alignment:=3DTrue, Border:=3DFalse, Pattern:=3DTrue, Width:=3DTrue Selection.Sort key1:=3DCells(xRowFirst&, xColOrigiNum&), Order1:=3DxlAscending, Header:=3DxlYes, _ OrderCustom:=3D1, MatchCase:=3DFalse, Orientation:=3DxlTopToBottom 'allow word-wrap With Selection .VerticalAlignment =3D xlBottom .WrapText =3D True .Orientation =3D 0 .AddIndent =3D False .ShrinkToFit =3D False .MergeCells =3D False End With '#22 calculate sum for each caller Selection.Subtotal GroupBy:=3D1, Function:=3DxlSum, TotalList:=3DArray(7, 8), _ Replace:=3DTrue, PageBreaks:=3DFalse, SummaryBelowData:=3DTrue 'freeze the headers, so you always see them while scrolling Rows("2:2").Select ActiveWindow.FreezePanes =3D True '#23 print format for worksheet 1 With ActiveSheet.PageSetup .PrintTitleRows =3D "$1:$1" .PrintTitleColumns =3D "" End With Application.ActiveWorkbook.Worksheets(1).Activate ActiveSheet.PageSetup.PrintArea =3D "" With ActiveSheet.PageSetup .LeftHeader =3D "" '.CenterHeader =3D "&""Tahoma,Fett""&12Call Detail Records" & Chr(10) & "&F " & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" .CenterHeader =3D "&""Tahoma,Fett""&12Call Detail Records" & "&F " & "" & "" & "" .RightHeader =3D "" .LeftFooter =3D "&D &T" .CenterFooter =3D "Seite &P von &N" .RightFooter =3D "" .LeftMargin =3D Application.InchesToPoints(0.78740157480315) .RightMargin =3D Application.InchesToPoints(0.78740157480315) .TopMargin =3D Application.InchesToPoints(0.984251968503937) .BottomMargin =3D Application.InchesToPoints(0.984251968503937) .HeaderMargin =3D Application.InchesToPoints(0.511811023622047) .FooterMargin =3D Application.InchesToPoints(0.511811023622047) .PrintHeadings =3D False .PrintGridlines =3D True .PrintComments =3D xlPrintNoComments .PrintQuality =3D 600 .CenterHorizontally =3D False .CenterVertically =3D False .Orientation =3D xlLandscape .Draft =3D False .PaperSize =3D xlPaperLetter .FirstPageNumber =3D xlAutomatic .Order =3D xlDownThenOver .BlackAndWhite =3D False .Zoom =3D False .FitToPagesWide =3D 1 .FitToPagesTall =3D 100 End With 'print format for worksheet 2 With ActiveSheet.PageSetup .PrintTitleRows =3D "$1:$1" .PrintTitleColumns =3D "" End With Application.ActiveWorkbook.Worksheets(2).Activate ActiveSheet.PageSetup.PrintArea =3D "" With ActiveSheet.PageSetup .LeftHeader =3D "" '.CenterHeader =3D "&""Tahoma,Fett""&12Call Detail Records" & Chr(10) & "&F " & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" .CenterHeader =3D "&""Tahoma,Fett""&12Call Detail Records" & "&F " & "" & "" & "" .RightHeader =3D "" .LeftFooter =3D "&D &T" .CenterFooter =3D "Seite &P von &N" .RightFooter =3D "" .LeftMargin =3D Application.InchesToPoints(0.78740157480315) .RightMargin =3D Application.InchesToPoints(0.78740157480315) .TopMargin =3D Application.InchesToPoints(0.984251968503937) .BottomMargin =3D Application.InchesToPoints(0.984251968503937) .HeaderMargin =3D Application.InchesToPoints(0.511811023622047) .FooterMargin =3D Application.InchesToPoints(0.511811023622047) .PrintHeadings =3D False .PrintGridlines =3D True .PrintComments =3D xlPrintNoComments .PrintQuality =3D 600 .CenterHorizontally =3D False .CenterVertically =3D False .Orientation =3D xlLandscape .Draft =3D False .PaperSize =3D xlPaperLetter .FirstPageNumber =3D xlAutomatic .Order =3D xlDownThenOver .BlackAndWhite =3D False .Zoom =3D False .FitToPagesWide =3D 1 .FitToPagesTall =3D 100 End With 'hide dialog when CDR Files are loaded LoadDialog.Label5.Visible =3D False LoadDialog.Repaint LoadDialog.Hide LoadDialog.MousePointer =3D fmMousePointerDefault '*******ERROR CODE********************* '************************************** '#24 Dim text, button, Titel, antwort, Mldg ' If Err.Number <> 0 Then ' Mldg =3D "Fehler # " & Str(Err.Number) & " wurde ausgel=F6st von " _ ' & Err.Source & Chr(13) & Err.Description ' Mldg =3D "Fehler # " & Err.Number & " wurde ausgel=F6st von " _ ' & Err.Source & Err.Description ' MsgBox Mldg, , "Fehler", Err.HelpFile, Err.HelpContext ' End If Application.DisplayAlerts =3D True Application.ScreenUpdating =3D True wks1.Activate End Sub '***********SAVE DATA****************** '************************************** '#25 Sub SaveData() Dim xPath$ Selection: CurrentDate =3D Application.text(Now(), "mm-dd-yy hh-mm") Backup =3D "Backup" & CurrentDate xPath$ =3D Application.GetSaveAsFilename(InitialFilename:=3DBackup, fileFilter:=3D"Backup (*.xls), *.xls") ActiveWorkbook.SaveAs Filename:=3DxPath$, FileFormat:=3DxlNormal, _ Password:=3D"", WriteResPassword:=3D"", ReadOnlyRecommended:=3DFalse, _ CreateBackup:=3DFalse MsgBox "Saving Call Detail Records: " & xPath$ ActiveWorkbook.Close =20 End Sub Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186542
  - 2
    - flushing stdout in a HTA ? Hello, I am quite new to MS-scripting; I wrote a script in .vbs catching several OS characteristics for a local computer. Now I would make this look pretty, and I am trying to send the output into a .hta : it works nicely, but the script is rather slow, and the .hta won't output the lines each time I write them, but all the lines at once : so unaware people may stay and wonder what is happening. Could I flush the output buffer in some way ? I browsed MSDN, but without great success. I tried outputting to the document itself using : Set objDocument = self.Document objDocument.open (...) objDocument.writeLn items ... and also the <SPAN> DataArea technique. Without success, all the lines are output in one time. (In the .hta, all the instructions are stored in the window_onload sub.) Does anybody have a hint ? Regards R. Grasso Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186539
  - 3
    - runas substitute Hi there! I would like to know if there is a way to locally run a program with different credentials form those of the current user, without invoking the "runas" command. In other words I need vbscript code who launch an application with an username and password provided as variables in the code itself, without asking the user. I tried WMI, using "WbemScripting.SWbemLocator" object and "objLocator.ConnectServer" method but they only works remotely, not locally. Any idea? Thanks in advance, Bye Andrea Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186534
  - 4
    - Problem with Protect method in MS Word. I'm building a web interface to allow users at a medical office to view/print/fax MS Word documents. However, these documents must be protected against changes by the viewing users. So I am endeavoring to copy the original file and then use the Protect method as a locking tool. It seems to work fine on my XP Pro laptop with Word 2003, but not on our Windows 2003 server with Word 2000. Interestingly, the Unprotect method does work on the server. <SCRIPT LANGUAGE="VBScript">  </SCRIPT> Thanks for any input. Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186531
  - 5
    - Delete folder script ran from? I need to delete the folder from which a script was called. So far I can delete the contents (including the script) but not the actual folder. Note the folder is open and the script is ran from the open folder. Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186530
  - 6
    - Processor Time Dedicated to Running a Script I have a script that performs some database queries. On my test system, it uses all of the available process time. If I look at Task Manager, the processor graph is pinned at the top. I run the same script on a customer's machine and it will only give the script 10% of the processor time with 75% of the process at system idle. Is there a setting that controls how much processing time slice is dedicated to running a script? Bernie Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186528
  - 7
    - Manipulate text input using VBScript I need to manipulate values entered into a text field i.e. select text, and move the cursor location within an input box. I'd be grateful if anyone could you point me towards any tutorials or give me some hints on how i can achieve this using VBScript ? Thanks Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186526
  - 8
    - Get the number of subfolders Is there a property of the parent folder that will give a number of sub folder within the parent i.e parentfolder subfolder1 subfolder2 subfolder3 I'm looking for the number of subfolder which in this case is 3. The directory level dosen't go any deeper Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186523
  - 9
    - Upload File to Access Database Dear Experts, I currently trying to use the FileUpload control from asp.net 2.0 to upload files. The uploading of the file I would like to store it in the Access Database. Unfortunately, I've no idea how I can do that. Can anyone provide me some solution by writing the code in vb.net? Many thanks in advance. Regards, SB Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186509
  - 10
    - AD LDAP query I'm trying to query the AD LDAP without logging into the AD Domain............ Is there anyway of querying ADs LDAP dbase without logging on.............. or alternatively is it possible logon using a vbscript so that I can query ADs LDAP..... this assumes that I am running the script on a computer that doesn't belong to the domain. So can I pass a string/command that can login to ADs LDAP via VBS.......... Thanks Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186504
  - 11
    - Problems with outputting attributes Hi, I want to output the what members each global distribution group has. For some reason it doesn't allow me to do so. It comes up with a type mismatch error when I try and output it to a file. The code is: Const ADS_SCOPE_SUBTREE = 2 Const ForAppending = 8 set fso = CreateObject("Scripting.FileSystemObject") set ofile = fso.OpenTextFile("c:\groups.txt",ForAppending, True) Set objConnection = CreateObject("ADODB.Connection") Set objCommand = CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE Set objRootDSE = GetObject("LDAP://RootDSE") strDNSDomain = objRootDSE.Get("DefaultNamingContext") strBase = "<LDAP://" & strDNSDomain & ">" strFilter = "(objectClass=group)" strAttributes = "name,groupType,Member" strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 'Search for all global distribution lists and write to file objCommand.CommandText = strQuery Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst 'Record the groups to a text file. ofile.writeLine(" ") ofile.WriteLine("GLOBAL DISTRIBUTION GROUPS") Do Until objRecordSet.EOF strGrpType = objRecordSet.Fields("groupType") If strGrpType = 2 Then strText = objRecordSet.Fields("name") & " " & objRecordSet.Fields("Member") ofile.WriteLine(strText) End If objRecordSet.MoveNext Loop 'Cleanup Set objRecordSet = Nothing Set objRootDSE = Nothing objConnection.Close ofile.close Hope you can help! Thanks in Advance! Greg Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186498
  - 12
    - Controls Value Dear Experts, How can I remain the value of other controls when I enter other value in another control with POSTBACK attribute is set to true. Currently, when I selected a date from a date picker into a textbox control, after that I enter a value into another textbox control with POSTBACK attribute is True. Once the page is refresh, the textbox value of the date selected is reset to empty again. How can I remain the value in the control? Regards, SB Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186491
  - 13
    - ADPlus.vbs - how to detect when the memory dump has completed? Hello all. Anyone familiar with ADPlus.vbs, the script used when running the Microsoft Debugging Tools for Windows? cscript adplus.vbs -hang -pn aspnet_wp.exe -pn inetinfo.exe -o c:\<Path_to_Put_Files_in> http://support.microsoft.com/default.aspx?scid=kb;en-us;286350 I've got a performance monitor alert configured to launch a batch file that will run ADPlus.vbs on a remote (Windows 2000 Advanced) server, and obtain a memory dump. It's all unattended and it works fine. Works fine for one iteration that is. Problem is, I have to run 3 seperate memory dumps; at 3 minute intervals, and each new memory dump cannot begin until the previous dump has completed. Using "start /wait" before adplus.vbs in the batch file doesn't work, since adplus.vbs spawns new processes which carry out the actual memory dump. I've poked around thoroughly but I cannot find a command line friendly way to detect when the memory dump has completed, so that I can have the batch file sleep for 3 minutes, then repeat the command and launch another one. Any help in solving this would be greatly appreciated! - Dave Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186489
  - 14
    - LDAP Query to find out the WINNT Domain Name Anybody know of a way for me to attach via LDAP to my AD to get the WINNT domain name? -- Paul Bergson Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186472
  - 15
    - How can I turn a script into an executable ? I have a .vbs script that I can run from the command line without a problem. (simply using 'cscript script.vbs') I don't know what syntax to use in order to properly create some sort of batch file which I could then run by double-clicking or using the task scheduler. If I just copy and paste the syntax text from the command line window, it will not work in a batch file, so I know I'm doing something wrong. Thanks in advance. Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186471
  - 16
    - I want form value from drow menu to go to two database fields Hi, I have a form with a drop down menu, and once they pick the value I want it to go to two fields in the database. <select name="color"> <option selected value="Red" >Red</option> <option selected value = "Yellow">Yellow</option> <option selected value = "Green"> Green </option> </select> I want the "color" to be updated in the database, and I also want the following; Select case color Case "Green" Field2 = 1212 Case "Yellow" Field2 = 1213 Case Else Field2 = 1214 End Select So after the user selects a certain color, and a submits the form the database fields; Color and Field2 are updated. I am sure how to do this. Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186470
  - 17
    - Probem with objRecordset.Fields.Item not populating properly Somehow DTSGlobalVariables("sSub").Value doesnot seem to get the value correctly, the value of objRecordset.Fields.Item("Va") doesnt seem to be adding to the DTSGlobalVariables("sSub").Value. Please help '************************************************************************ ' Visual Basic ActiveX Script '************************************************************************ Option Explicit Function Main() Dim objConnection Dim objRecordSet Dim strTotal Dim strPathtoTextFile DTSGlobalVariables("sSub").Value = "Errors: = " strtotal = strtotal & DTSGlobalVariables("sSub").Value & "0" On Error Resume Next Const adOpenStatic = 3 Const adLockOptimistic = 3 Const adCmdText = &H0001 Set objConnection = CreateObject("ADODB.Connection") Set objRecordSet = CreateObject("ADODB.Recordset") strPathtoTextFile = "M:\Rep\AA\" objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & strPathtoTextFile & ";" & _ "Extended Properties=""text;HDR=NO;FMT=Delimited""" objRecordset.Open "SELECT * FROM svcmont.txt", _ objConnection, adOpenStatic, adLockOptimistic, adCmdText Do Until objRecordset.EOF Wscript.Echo "Ty: " & objRecordset.Fields.Item("Ty") Wscript.Echo "Va: " & objRecordset.Fields.Item("Va") objRecordset.MoveNext Loop DTSGlobalVariables("sSub").Value = DTSGlobalVariables("sSub").Value & objRecordset.Fields.Item("Va") If strtotal <> DTSGlobalVariables("sSub").Value Then Main = DTSTaskExecResult_Success Else Main = DTSTaskExecResult_Failure End If End Function '************************************************************************ Sample of input file: -------------------- Q, 0 QC, 0 Q, 0 Q, 0 Q, 0 QC, 0 Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186468
  - 18
    - FSO Using the FSO how can I open a file for read/write and go to the end of the file for a write operation? I have it working by keeping the file open but I'd rather open it when I need it and close it when I'm done. Thanks, Bart Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186467
  - 19
    - Networking settings Where can I locate some sample code to set the right nertworking configuration (IP address and/or DHCP client, proxy, DNS server, default gateway, ...)? Mario Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186465
  - 20
    - error 80040605 running "mapi.session" While running Set objMBXSession = Server.CreateObject("MAPI.Session") in an .asp page we get an error in the browser (asp0177 80040605) If we run our asp (which prompts for a User ID and pw) as an administrator of the box the asp code is running from it works fine, but if we run it as a basic or power user, we get this error. We are trying to access the users mailbox to get information about the mailbox at this step of the code. Anyone ever tried to do this? any suggestions?? Thanks Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186463
  - 21
    - how to create authentification box Hi all, I need to create an authentification box to map network drive. I need to prompt the user to enter his username and password.is this possible !!! thanks Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186459
  - 22
    - Enumerate Admins I am trying to setup a script to audit Builtin Administrators and Domain Administrators for every domain in our forest. I would like to have a script that runs without any user interaction and dumps to some kind of file for reporting purposes. Any help is appreciated. Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186456
  - 23
    - QUERY: debugging ASP VBScript I am currently developing a website in ASP (VBScript) using MS Visual C#.NET IDE. I just create a new "ASP.NET Web Application" and point to my local webserver (IIS) of my website address. Then I just go through each file/folder and right-click, selecting "Include in project". The IDE is nice in that it checks, verifies id tags, etc. What am wondering is whether it's possible to debug my ASP website using the MS Visual Studio.NET's debugger. I did a google search for 'debugging ASP VBScript' and got: http://www.microsoft.com/windows2000/en/server/iis/htm/asp/iiwadbug.htm It seems possible, however I can't seem to get it working. Anyway knows how to debug ASP scripts efficiently? Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186443
  - 24
    - Determinine IE.Navigate2 Status I am trying to automate the daily morning system checks. Part of the items to check is a bunch of URL's. I have a script that opens them all in a new window for manual verification. It seems possible but I can't figure out how to determine the status of the recently navigated url. Is there anyway way to use .NavigateError or some other method to determine if a 404 error type is the result of the navigate function? Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186441
  - 25
    - Identifying an empty field to change the backgorund color of the t Good morning, I am a newly self made vbscript developper. I am developping a web based access data collection system and I need to change the background color of the text label whenever a field is set to empty by deleting the content. For instance: document.getElementById("Tickets_OrderNu").value= ???? I tried empty, blank, null, nothing. No success up to now. Is this posiible? Maybe .value is not the right keyword, should I use another one? Thanks Gilles -- GillesABelanger Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186440
- Next
  - 1
    - How to get file's info I need to display in an asp page info about a file saved on the disk. The info are those i see when i open the properties window of the file (version, copyright, etc) Which functions i have to use ? Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186435
  - 2
    - Simplest code to access default gateway settings Hi For a Windows 2000 Professional SP 4 machine known to have only one network interface, what would be the simplest way to read the default gateway ? Also, likewise to set it. Thanks Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186426
  - 3
    - Script to change password via objUser.setpasswd I have written a script that will change a password from the sources in MS Scripts resource. This is the actual code: strUserDN = "cn=testusera,ou=Admins,dc=testdc01,dc=domain,dc=com" strNewPasswd = "pass123456" 'Set objUser = GetObject("LDAP://" & strUserDN) objUser.SetPassword(strNewPasswd) however when I run it, the following error occurs " A referral was returned from the server." I read some posts from here and it said add the DC's name to the UserDN path testdc01, however it still doesn't work. The original script did't have that and it still gave the same error........ Any on please help.... Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186419
  - 4
    - Double byte characters (Chinese/Japanese/) Hi....... Need some serious help................ I'm trying to write a script that can determine the filenames that have doublebyte characters............. by reading a text file or recursing through a directory..... Has anyone ever done something like this before..... Thanks in advance........ Zeno Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186414
  - 5
    - Date Picker value Dear Experts, Currently I am creating a webform using sp.net 2.0. I would like to create a date picker in my webform. I managed to create a a button to call-up the calendar and using the Calendar control from the toolbox. I would like to know how can I pass the value back to a textbox in my original form with the selected date from the calendar? Also, can I have the selection of the time as well? Regards, SB Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186413
  - 6
    - Problems with outputting attributes Hi, I want to output the what members each global distribution group has. For some reason it doesn't allow me to do so. It comes up with a type mismatch error when I try and output it to a file. The code is: Const ADS_SCOPE_SUBTREE = 2 Const ForAppending = 8 set fso = CreateObject("Scripting.FileSystemObject") set ofile = fso.OpenTextFile("c:\groups.txt",ForAppending, True) Set objConnection = CreateObject("ADODB.Connection") Set objCommand = CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE Set objRootDSE = GetObject("LDAP://RootDSE") strDNSDomain = objRootDSE.Get("DefaultNamingContext") strBase = "<LDAP://" & strDNSDomain & ">" strFilter = "(objectClass=group)" strAttributes = "name,groupType,Member" strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" 'Search for all global distribution lists and write to file objCommand.CommandText = strQuery Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst 'Record the groups to a text file. ofile.writeLine(" ") ofile.WriteLine("GLOBAL DISTRIBUTION GROUPS") Do Until objRecordSet.EOF strGrpType = objRecordSet.Fields("groupType") If strGrpType = 2 Then strText = objRecordSet.Fields("name") & " " & objRecordSet.Fields("Member") ofile.WriteLine(strText) End If objRecordSet.MoveNext Loop 'Cleanup Set objRecordSet = Nothing Set objRootDSE = Nothing objConnection.Close ofile.close Hope you can help! Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186411
  - 7
    - Help me again with Script please Following is my script my computer startup script in my GP. I'm not very good in scripting but I managed to put this script together. Two things are not working right in this script. Firstly, I want the unistallation process complete before the login prompt appears but this does not happen. I am using sleep wscript.sleep this is not ideal and not working well because some machines need longer time and others need shorter time, depending on the network connection and speed of PCs. In a thinking in the lines of putting a function where if the uninstall process begins the login prompt is hidden/disabled or unavailable is until the whole proccess is completed and rebooted. Please, help me as I need to have this working by the end of this week. Secondly, After unistall process completes I want it to reboot the machine again but this does not happen as well. This probably because not completing the uninstall process and the using logon interferring but I'm not sure. Is anything wrong with my RebootPC() function? how can I fix it? Thank you everyone for your quick help ' ---------------------------------------------------------------- Const HKEY_LOCAL_MACHINE = &H80000002 strComputer = "." Set WSHShell=WScript.CreateObject("WScript.Shell") Set fs=CreateObject("Scripting.FileSystemObject") Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\"&_ strComputer & "\root\default:StdRegProv") rem check if file exist, if it is jump out If Not fs.fileExists("c:\UninstallOfficepro.log") Then 'WScript.Echo "officepro removed" 'Else 'Set the registry key path And thi strKeyPath = _ "Software\Microsoft\Windows\CurrentVersion\Uninstall\{90110409-6000-11D3-8CFE-0050048383C9}" strValueName = "DisplayName" Return = objReg.GetExpandedStringValue(HKEY_LOCAL_MACHINE,_ strKeyPath,strValueName,strValue) ' If key does exist and display name is Microsoft Office XP Professional then run uninstall command If (Return = 0) And (strValue="Microsoft Office XP Professional") And (Err.Number = 0) Then rem WScript.Echo "Program is " & strValue & " " & StrKeypath WshShell.Run _ ("%systemroot%\System32\msiexec.exe /x{90110409-6000-11D3-8CFE-0050048383C9} /passive /qb /l*v C:\UninstallOfficepro.log") WScript.Sleep(5000) 'RestartPC() 'WScript.Sleep(5000) Else 'WScript.Echo _ ' "GetExpandedStringValue failed. Error = " & Err.Number WScript.Quit(0) End If End If WScript.Quit(0) ' --------------------------------------------------------------------------------- ' This function reboots the Pc after uninstalling officepro Function RestartPC() strComputer = "." Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate,(Shutdown)}!\\" & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery _ ("Select * from Win32_OperatingSystem") For Each objOperatingSystem in colOperatingSystems ObjOperatingSystem.Reboot() Next End Function Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186410
  - 8
    - JScript VBScript and using Eval() I primarily use js because that's what I know. Presently I use vbs only for goodies like MsgBox and FormatCurrency. I'd like to know if there is a better way than Eval() to handle a string in vbs or, a better approach than what I'm doing. Here is a web page example that adds MsgBox for Internet Explorer. // JS var vb_btnFocus='vbDefaultButton2'; function iniMsgBox(){ window.confirm=function(msgStr){ return vb_confirm(msgStr) } } ' VBS iniMsgBox() Function vb_confirm(msgStr) vb_confirm = MsgBox(msgStr,vbOKCancel + vbQuestion + Eval(vb_btnFocus) + vbApplicationModal,"Some Title") = vbOK End Function -- gph ------------------------------------------------------------------------ Posted via http://www.codecomments.com ------------------------------------------------------------------------ Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186408
  - 9
    - copying from an msi with a vbscript "Set fso = CreateObject(""Scripting.FileSystemObject""): src = property(""SourceDir"") & " & chr(34) & "Filename.ext" & chr(34) & ": dest = property(""INSTALLDIR"") & ""\"" & " & chr(34) & "idcfg.ini" & chr(34) & ": fso.CopyFile src,dest,True" anyone know what is wrong with this script? I'm totally new to this and can do with some help. Thank you Sam Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186406
  - 10
    - enumerating all OUs in a Domain and then using the result to populate drop-down list Good afternoon! I hope that this question has not been asked and answered in either of these two news groups. I looked but did not find anything. So, now to my question. Several months ago I created an HTA (using VBScripting) that creates user account objects. It is nice and simple but does a really good job. However, a lot of it is hard coded. I would like to change this to be a bit more dynamic. What I would like to do is to enumerate all of the OUs in the organization (that should not be very difficult to do...) and then use the result of this to populate a drop-down list. That is where I have a problem. I do not know how to do this. I know how to echo the results to the screen. However, this does not help me in what I am trying to do. If anyone can guide me to some references - or share the code that does this - I would be very appreciative. I worked on this for a couple of weeks several months ago and then got pulled into other directions. Before that I did a very little bit of VBScripting. So, my 'base knowledge' is lacking. Thank you, Cary W. Shultz Roanoke, VA 24012 Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186401
  - 11
    - Getting screen parameters in a script When I use VBS in a HTML file, I can get the screen width and height with width=screen.width and height=screen.height I would like to get the width and height in a stand alone .vbs script so that I can place display objects where I want them in relation to the screen size. Can anybody help? -- Crash Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186388
  - 12
    - regular expression to extract e-mail address Greetings, how do I create a regulare expression that isolates the e-mail address (and places it into another string variable) in the following input line (read in from a text file): From: "Shmoe, Joe" <joe.shmoe@work.com> Thanks Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186386
  - 13
    - Update Access File Hello; i am studing vbscrip but my office ask me if i can write a script. In particular i need a script for update a field in a access database with the current day. How can help me ? Bye BYE THanks Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186357
  - 14
    - Talking between HTA and dialog box Hello, I have been working on an HTA application for work and I have hit a wall. In a nutshell I am trying to gather information from the user in a dialog box that I have opened with the window.showModalDialog() method. The Dialog box opens fine but when it comes time to pass information to or from the dialog box I get "permission denied" and "exception occured". I have tried using the window.open() method with similar results. I ran into a similar problem with the iFrames that I have in the application but resolved it with the application="yes" attribute. It's obvious that this is some sort of security related issue but the answer has been eluding me. Can anyone drop me a clue? Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186355
  - 15
    - Can't determine if checkbox is checked I'm using VB script to determine how this form is filled out: <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>Name</title> </head> <body> <font <p style='margin-left:'>Name:       <input type='text' name='UID' size='10' style='font-family: Times New Roman; font-size: 8pt'><p style='margin-left:'>Password: <input type='password' name='PWD' size='8' style='font-size: 8pt; font-family: Times New Roman'> </p> <p style='margin-left:'>Remember this logon? <input type ='checkbox' name='CBREM' value='OFF'>   <input type='submit' value='LOGON' name='Submit' style='font-size: 8pt; font-family: Times New Roman'></p> </form> </body> </html> I can get the value of both UID and PWD using Session("UID") and Session("PWD") but I can't find the status of CBREM. I've tried both Session("CBREM") and Request.Form("CBREM") but no joy. How can I determine if the checkbox is checked? Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186353
  - 16
    - No progress with progress bar Hi I am attempting to implement an AJAX (-like) application using IIS on Windows XP. Here is the process: 1. An XMLHTTPRequest is made initially for a report that can take up to 10 secinds to complete. While it is running, it periodically updates a session variable showing how far along it is. 2. After this request is started on the client, a Window.SetInterval(500) call is made that itself initiates another XMLHTTPRequest to the server (all separate vars and functions are used) to see how the report is progressing. It reads the Session var and returns the progress. The screen is updated with this progress text and %complete via a div acting as a progress bar. 3. When the initial XMLHTTPRequest returns, it cancels the Progress XMLHTTPRequest request using Window.ClearInterval Each of the XMLHTTPRequest starts and ends. The trouble is that the Progress requests, though they leave the client browsers as expected, they are not sensed at the server until after the inital report XMLHTTPRequest has completely finished. It appears that the 2nd and subsequent XMLHTTPRequest arrive at the server and are queued to be sequentially acted upon. You only see 0% and 100% - nothing in between. My question is: can more than one request from the same client and the same session be acted upon in IIS 5.1? Have I got this right? Thanks in advance, UmbraLimi Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186350
  - 17
    - No progress with progress bar Hi I am attempting to implement an AJAX (-like) application using IIS on Windows XP. Here is the process: 1. An XMLHTTPRequest is made initially for a report that can take up to 10 secinds to complete. While it is running, it periodically updates a session variable showing how far along it is. 2. After this request is started on the client, a Window.SetInterval(500) call is made that itself initiates another XMLHTTPRequest to the server (all separate vars and functions are used) to see how the report is progressing. It reads the Session var and returns the progress. The screen is updated with this progress text and %complete via a div acting as a progress bar. 3. When the initial XMLHTTPRequest returns, it cancels the Progress XMLHTTPRequest request using Window.ClearInterval Each of the XMLHTTPRequest starts and ends. The trouble is that the Progress requests, though they leave the client browsers as expected, they are not sensed at the server until after the inital report XMLHTTPRequest has completely finished. It appears that the 2nd and subsequent XMLHTTPRequest arrive at the server and are queued to be sequentially acted upon. You only see 0% and 100% - nothing in between. My question is: can more than one request from the same client and the same session be acted upon in IIS 5.1? Have I got this right? Thanks in advance, UmbraLimi Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186349
  - 18
    - Query status of virus scanner and 3rd party firewall in security I am working on a vbscript that analyzes some parameters of a system installation. As part of it I want to check which virus scanner and which 3rd party firewall is installed and its status. Basically I am interested in the status information just the way it is shown in the security center. I know how to query wmi through the winmgmts:\\.\root\SecurityCenter object. However, it seems as if this information is not always accurate. In particular certain anti-virus and 3rd party firewall products can not be found through wmi although the security center does display that they are installed and the proper status. Is there any other way to retrieve this information in vbs? Thx, Gerald Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186343
  - 19
    - Function calculation of numeric array Thanks to all for the recent help. I am a newbie with an incpmplete knowledge of vbscript. I am attempting to create a very simple function to learn functions which calculate numerical arrays. The function here called TotalEvents simply counts the passes through the array. It is called through the variable mytotalevents(myarray) The two problem areas are delimited within ======== signs If I "comment out" the function and the function call, all works well (it calcuates an average). But the page "dies" when I attempt to implement the function. Is it in the wrong place? Script follows <html> <head><title>Calculate Average</title> <script type="text/vbscript"> <!-- '================================================================== Function TotalEvents(ParamArray Args() As Variant) As double Dim i as integer Dim mcount For i=0 to ubound(Args) mcount=i next TotalEvents=mcount End function '====================================================================== sub submit_OnClick dim theForm, myArray, mTotal, mAverage set theForm = document.myInputForm myArray = split(theForm.text1.value,vbCrLf) dim CurrentTradeAmt dim myTotalEvents if not IsNumeric(myArray(ubound(myArray))) then max = ubound(myArray) - 1 else max = ubound(myArray) end if for i = 0 to max CurrentTradeAmt= Cdbl(myArray(i)) mtotal = mtotal + CurrentTradeAmt next '======================================================== myTotalEvents=TotalEvents(myArray) '======================================================= mAverage = mtotal / (max + 1) document.getElementById("total").innerHTML = "Total: " & FormatCurrency(mTotal,2) & "<br>" document.getElementById("average").innerHTML = "Average: " & mAverage & "<br>" document.getElementById("mytotalevents").innerHTML = "Total Events: " & myTotalEvents document.getElementById("text1").innerHTML = " " end sub Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186341
  - 20
    - Changing title in IE I am using a local instance of IE to display data in a script, starting with IE.navigate "about:blank" Everything works fine, but the IE title bar shows "about:blank." I'd like to show something more interesting and informative. Can somebody tell me how? -- Crash Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186315
  - 21
    - Registry permissions Does anybody know how to modify registry permissions using VBScripts? Thanks!!! Felipe Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186312
  - 22
    - How Can I read a specific sector from harddisk? Hi, I need to read some data from sector 5 from the local harddisk. Our desktop management suite (ZENworks 7) stores some important information like the computername and the domain to which the machine belongs in that specific sector. When I do a re-image of the machine this information is untouched by the imaging proces. Afterwards a vbscript should read this information and gives the machine it's name back and joins the machine to the domain. I need a sample script which dumps a harddisk sector of my choice into a variable (array?). Writing to this sector would be nice to add some features to the script, but it isn't what I am looking for at the moment. Does anyone know if this can be done with VBScript? Or do I have to use some more advanced programming languages (e.g. Visual Basic)? Thanks for yor help! Greetings Eric Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186311
  - 23
    - Wanting help with changing the Appearance key in the registry Hi All, I've got an issue where I'm wanting to change the appearance key in the registry and apply when there is no locally cached profile on the machine. An Example of what I'm wanting.. 1. Log in as test user (no locally cached profile) 2. Change the Appearance of the desktop 3. Hive out the registry key HKCU\Control Panel 4. Log off and delete the locally cached profile 5. Log in as the same test user (no locally cached profile) 6. Apply the hive 7. The desktop Appearance is now changed But I've found that Windows need to apply the change to the ntuser.dat. If this does not exists then back to defaults. Any help would be great! -- IT Consultant and yes, armed and dangerous.. Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186310
  - 24
    - how to find encrypted file using file system object how could one tell is a file is encrypted? I looked at the script help for file object properties, I found attributes but none of the attributes list encryption. I am trying to locate files that are encrypted so I can manually decrypt before transferring to a new PC Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186306
  - 25
    - Script to Enumerate SACL This script works on Windows 2000 Server but fails on Windows Server 2003- the arrACEs variable returns a NULL value. Any ideas? Did the way the GetSecurityDescriptor method works get changed in 2003? Thanks in advance. strFileName = "C:\temp" SE_DACL_PRESENT = &h4 SE_SACL_PRESENT = &h16 ACCESS_ALLOWED_ACE_TYPE = &h0 ACCESS_DENIED_ACE_TYPE = &h1 AUDIT_ACE_TYPE = &h2 FILE_ALL_ACCESS = &h1f01ff FILE_APPEND_DATA = &h000004 FILE_DELETE = &h010000 FILE_DELETE_CHILD = &h000040 FILE_EXECUTE = &h000020 FILE_READ_ATTRIBUTES = &h000080 FILE_READ_CONTROL = &h020000 FILE_READ_DATA = &h000001 FILE_READ_EA = &h000008 FILE_SYNCHRONIZE = &h100000 FILE_WRITE_ATTRIBUTES = &h000100 FILE_WRITE_DAC = &h040000 FILE_WRITE_DATA = &h000002 FILE_WRITE_EA = &h000010 FILE_WRITE_OWNER = &h080000 Set objWMIService = GetObject("winmgmts:") Set objFileSecuritySettings = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'") intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD) intControlFlags = objSD.ControlFlags WScript.Echo "Caption: " & objFileSecuritySettings.Caption if intControlFlags AND SE_SACL_PRESENT Then arrACEs = objSD.SACL ' WScript.Echo typeName(arrACEs) For Each objACE in arrACEs WScript.Echo "objACE.Trustee.Name: " & objACE.Trustee.Name ' If (objACE.Trustee.Name = Wscript.Arguments.Named("user")) Then WScript.Echo "objACE.Trustee.Domain\objACE.Trustee.Name: " & objACE.Trustee.Domain & "\" & objACE.Trustee.Name ' WScript.Echo "objACE.Trustee.SidLength : " & objACE.Trustee.SidLength ' WScript.Echo "objACE.Trustee.SidString : " & objACE.Trustee.SidString Wscript.Echo "" ' If (objACE.AceType = AUDIT_ACE_TYPE) Then Wscript.Echo "Controlflags : " & objsd.ControlFlags Wscript.Echo "Access Mask : " & objACE.AccessMask Wscript.Echo "ACE Flags : " & objACE.ACEFlags Wscript.Echo "ACE Type : " & objACE.ACEType Wscript.Echo "" ' objAce.AccessMask = 131072 ' RetVal = objFileSecuritySettings.SetSecurityDescriptor(objSD) ' End If ' End If Next Else WScript.Echo "No SACL present in security descriptor" End If Tag: Scan text file listing for non-alphanumeric characters.......... Tag: 186300

I'm trying a script that will read an output file of directory and
filename/path listings for non-alphanumeric characters...........

This is because the listing contains Chinese/Japanese/Korean
paths/filenames so I hope doing a search for non-alphanumeric
characters will detect such filenames/paths for me...........

Any suggestions would be appreciated...........

Thanks.........

Top