Keep latest 7 folders and delete remaining folders

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
    - Script output I am trying to write output to the screen in columns. Is it possible to tell the script were to put the cursor so the columns line up? Tag: Keep latest 7 folders and delete remaining folders Tag: 186628
  - 2
    - Display driver mapping progress What method do you suggest in order to display the drive mapping status. For example, display: drive, share, success or failure. I dont want a box for each maping but a single window with updating status. Tag: Keep latest 7 folders and delete remaining folders Tag: 186626
  - 3
    - Bulk Insert I have the following on an asp page - <% Set Con=server.CreateObject("ADODB.Connection") con.Open "DSNNAME", "USERNAME", "PASSWORD" con.Execute "BULK INSERT tblName FROM 'C:\Inetpub\wwwroot\file.csv' WITH (MAXERRORS = 0, FIELDTERMINATOR = '"",""', ROWTERMINATOR = '\n')" con.close Response.Redirect "success.asp" %> The script appears to run and return me to success.asp, however there is nothing posted in the db. What am I doing wrong? -- Olivia Towery Tag: Keep latest 7 folders and delete remaining folders Tag: 186623
  - 4
    - problems with vbscript if statement This is the VBScript code that isn't working.... --- dcreated = fileName.DateCreated ddiff = DateDiff("d", Now, dcreated) If ddiff < 8 Then 'Blah End if --- I create a variable ddiff... this variable contains the nr of days from the created date until today. When I print the variable ddiff, it contains the right number. But when I use it in the If statement (<8) then --- ALL --- the ddiff values, also the ones that are bigger than 7, pass this statement!! I checked the contents of the variable ddiff by printing them, and the are correct. It seems that the If statement is nog working... What to do? Regards, Tom Tag: Keep latest 7 folders and delete remaining folders Tag: 186619
  - 5
    - Removing a printer Hi, Has anyone ever succeeded in removing a printer from a Netware print queue? I have several computers in my organization that can print to this print queue and I've been trying to remove this reference by using a vbScript. Thanks in Adcvance, JeffH Tag: Keep latest 7 folders and delete remaining folders Tag: 186618
  - 6
    - How to sort a comma delimited text file? Trying to make a script that takes 4 different event log files, and create one summary log file, with all the events sorted by date. Any suggestions? TIA! / Per ps. To simplify, lets say we have 4 columns, DATE/TIME, EVENT, SOURCE, DEST and logfiles, Log1, Log2, Log3, Log4. Tag: Keep latest 7 folders and delete remaining folders Tag: 186617
  - 7
    - Reqular expression quiz Hi, I am trying to find a pattern that allows me to avoid words within quotations, eg "word1 word2 word3" Word outside (without quotation) needs to have quotes added. simplified as: regEx.Pattern = "\b" & keyword & "\b" regEx.Global = true strWord = regEx.Replace(strng, chr(34) & keyword & chr(34)) input. word1 word2 word3 "word1 word2 word3" output: "word1" "word2" "word3" "word1 word2 word3" the patter to match string within quotes is """.*?""" ' but I need to have it ignored. Thanks in advance Christian Tag: Keep latest 7 folders and delete remaining folders Tag: 186614
  - 8
    - Permission Denied: Msgbox - Client-side Error I have an ASP application that I wrote for my company that's been in use for three years with this sporadic problem that I've never found a definitive answer to. I'm getting this error from the client-side vbscript, but only at this new site. When I change the msgbox function to alert, it works fine. I also have another page that generates client-side script to display a message box and this page generates the same error. When I change the server-side script to create an alert instead of a msgbox, it works. There has to be some I.E. setting that controls this problem. I'm aware that in several cases, using VBScript will not perform the expected action and I had to resort to Javascript, but this makes no sense at all. Any ideas would be appreciated. Just to make myself absolutely clear, this is client-side script that's causing the error. Thanks, Terry. Tag: Keep latest 7 folders and delete remaining folders Tag: 186612
  - 9
    - Does Ping.exe return any values? I want to create a script that with help a person determine if a pc is online or not based upon the PC name entered. My first thought was just..... Set WshShell = WScript.CreateObject("WScript.Shell") Dim PcnameVariable PcnameVariable = Trim(InputBox("Enter a pc name ","Enter a PC name")) Wshshell.run "ping "&PcnameVariable ,0, false 'surpress the ping output window Then use a MsgBox to indicate if that PC in on-line or not. No need for the user to see anything else Any Ideas, or is there a easier way? thanks Tag: Keep latest 7 folders and delete remaining folders Tag: 186608
  - 10
    - W2K3 Startup Script. ACCESS IS DENIED ERROR All. I have a startup script that runs on Windows XP Clients to install software when the computer starts up. Basically it's a batch file that runs the install command and parameters specific to each computer. This worked justed fine when the script resided on our Windows 2000 File server. We have upgraded the file server to WIndows 2003 Server. Now when the script runs I get ACCESS IS DENIED errors. I have added the 'domain computers' group to the NTFS share permissions on the folder where the script and software reside. I have even added 'Everyone' (Full Control) to the folders with the same result. Something has changed in W2k3 as far as shares / permissions for startup scripts or local system access but I dont know what. Anyone have any suggestions? Also, my script will work fine if I host it to a Win2K server. But i really need it to run from my W2k3 server. TIA. Drum on .. .. . . . Tag: Keep latest 7 folders and delete remaining folders Tag: 186605
  - 11
    - i need some help with command buttons i am trying to design a simple application that will open several different programs outside of the regular environment. for example i would like to click a command button and then open up a web site. then another button will open up an access database, and another will open up a customer database. can anyone help me?? -- Christopher S. Coviello Tag: Keep latest 7 folders and delete remaining folders Tag: 186604
  - 12
    - Resetting the default value Is there any way to reset a default value in the registry to completely null via VBScript? The only method that has worked for me is deleting the value and letting it get recreated automatically. However, for the specific key that I need to change, the Users group has permission to create/change values but not to delete. If it helps, the key is HKLM\SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources. If the default value of this key is set to a non-null value, even an empty string, the ODBC applet will not display any newly created data sources in the System DSN list. Tag: Keep latest 7 folders and delete remaining folders Tag: 186601
  - 13
    - how to get file version info thru a share? I tried using Shell and NameSpace to lookup file version numbers over a share as in \\abc\c$\installs but it fails to return the same info as c:\installs for example ==========runme.vbs============ function GetFileVersion(ThisFolder, FileName) dim objShell : set objShell = CreateObject("Shell.Application") dim objFolder : set objFolder = objShell.NameSpace(ThisFolder) dim objItem : set objItem = objFolder.ParseName(FileName) GetFileVersion = "" for i = -1 to 34 GetFileVersion = GetFileVersion & objFolder.GetDetailsOf(objItem,i) & vbcrlf next end function ' assume that c:\temp contains notepad.exe and xxxxx is the computer name ' the following two lines of code return different information. ' in particular the i = -1 "File Version:" is missing on the share C$\temp WScript.Echo GetFileVersion ("c:\temp", "notepad.exe") WScript.Echo GetFileVersion ("\\xxxxx\c$\temp", "notepad.exe") ======================== Is there any other way to get file version info on .exe, .ocx, .dll ? -- ======================================================================= Beemer Biker joestateson@grandecom.net http://TipsForTheComputingImpaired.com http://ResearchRiders.org Ask about my 99'R1100RT ======================================================================= Tag: Keep latest 7 folders and delete remaining folders Tag: 186600
  - 14
    - Computers in OU [WildPacket] I have computers in various OUs and they have been move around so they are in the wrong OU's. Is there are query/script or any way I can find which computer belongs to which OU? Instead we manually go and check each of them??? Advise please. Thanks, Tag: Keep latest 7 folders and delete remaining folders Tag: 186597
  - 15
    - help Can one know with a script in that pc it has logon session an user? Tag: Keep latest 7 folders and delete remaining folders Tag: 186593
  - 16
    - Set LMHosts Lookup Hello, i want to set "WINSEnableLMHostsLookup" in WMI "Win32_NetworkAdapterConfiguration", but i just can read the value. Unfortunately there is no Setter for this. Is there any other way ? IÂ´m trying not to use any 'external' tools like netset or netsh. kind regards -- Jens Frieben (Germany) Tag: Keep latest 7 folders and delete remaining folders Tag: 186591
  - 17
    - How to admin smtp service with vbscript Hi: I need to admin the smtp service in two remote servers in my company. I like to verify if the service is active, I don't need to send mail, only to verify the service is running. Can anybody help me? Thanks everybody... Tag: Keep latest 7 folders and delete remaining folders Tag: 186585
  - 18
    - Display Access Database OLE Object Dear Experts, I'm using the asp.net 2.0 fileupload control to upload files into Access Database. The file types that being uploaded may be in word, excel or image format. Therefore, I would like to seek your help to show me how can I have a link in my webpage to view this file by reading from the database? Your feedback/help is very much appreaciated. Regards, SB Tag: Keep latest 7 folders and delete remaining folders Tag: 186581
  - 19
    - objDSO.OpenDSObject Query from workgroup computer............ I'm connecting to AD LDAP via the objDSObject query to get the UserDN for a given account. I have written the code that allows me to bind to the AD LDAP successfully but not sure how to query the UserDN for a given user............ this is my progress so far allowing me to bind to the AD LDAP sucessfully..... I can't figure out how to use the objDSO.OpenDSObject command to get the UserDN name ......... can anyone advise how this can be done ?? 'On Error Resume Next ' --- Constants must be declared. --- Const ADS_SECURE_AUTHENTICATION = 1 Const ADS_SERVER_BIND = 512 '--- Admin Credentials ---- strUsername = "gg\administrator" strPassword = "password" ' --- Use OpenDSObject to bind with credentials --- Set oDSObj = GetObject("LDAP:") ' ServerName is Netbios name Set oAuth = oDSObj.OpenDSObject("LDAP://labdc3/dc=gg,dc=com", strUsername, strPassword, _ ADS_SECURE_AUTHENTICATION + ADS_SERVER_BIND) If Err.Number <> 0 Then MsgBox "Logon failure: unknown user name or bad password." End If MsgBox "You have successfully bound to : " & oAuth.Get("Name") & " as " & strUsername ' Continue with script to perform operation on AD... ' Constants for the NameTranslate object. Const ADS_NAME_INITTYPE_GC = 3 Const ADS_NAME_TYPE_NT4 = 3 Const ADS_NAME_TYPE_1779 = 1 ' Specify the NetBIOS name of the domain and the NT name of the user. strNTName = "gg\testuserA" ' Use the NameTranslate object to convert the NT user name to the ' Distinguished Name required for the LDAP provider. Set objTrans = CreateObject("NameTranslate") ' Initialize NameTranslate by locating the Global Catalog. objTrans.Init ADS_NAME_INITTYPE_GC, "" ' Use the Set method to specify the NT format of the object name. objTrans.Set ADS_NAME_TYPE_NT4, strNTName ' Use the Get method to retrieve the RPC 1779 Distinguished Name. strUserDN = objTrans.Get(ADS_NAME_TYPE_1779) ' Bind to the user object in Active Directory with the LDAP provider. Set objUser = GetObject("LDAP://" & strUserDN) MsgBox strUserDN Thanks in advance Tag: Keep latest 7 folders and delete remaining folders Tag: 186580
  - 20
    - JScript VBScript and using Eval() Thanks for pointing that out Alexander. It is the simplest solutions that make the most sense :) -- gph ------------------------------------------------------------------------ Posted via http://www.codecomments.com ------------------------------------------------------------------------ Tag: Keep latest 7 folders and delete remaining folders Tag: 186577
  - 21
    - List email address from multiple files I've 1500 files; each with an email address. I want to retrieve the email address, put it in a common file and send a reply email. Tag: Keep latest 7 folders and delete remaining folders Tag: 186557
  - 22
    - Use VBScript To Delete History Is it possible to delete pages from a user's history using VBScript? How is this done? -- Hmm...they have the Internet on COMPUTERS now! Tag: Keep latest 7 folders and delete remaining folders Tag: 186553
  - 23
    - Determine how long a user has been logged in I have the following code which can determine the Machine uptime below I would like some code which can determine the time a user has been logged in without logging off. Almost like a User uptime script. Can anyone help me? strComputer = *.* Set objWMIService = GetObject _ ("winmgmts:\\" & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery _ ("Select * from Win32_OperatingSystem") For Each objOS in colOperatingSystems dtmBootup = objOS.LastBootUpTime dtmLastBootupTime = WMIDateStringToDate(dtmBootup) dtmSystemUptime = DateDiff("h", dtmLastBootUpTime, Now) if dtmSystemUptime > 90000 Then wscript.echo "Unable to connect. The machine may not exist or is otherwise unavailable" wscript.quit Else Wscript.Echo dtmSystemUptime & " " & "Hours" End IF Next Function WMIDateStringToDate(dtmBootup) WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" & _ Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _ & " " & Mid (dtmBootup, 9, 2) & ":" & _ Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, _ 13, 2)) End Function Tag: Keep latest 7 folders and delete remaining folders Tag: 186545
  - 24
    - Scan text file listing for non-alphanumeric characters.......... 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......... Tag: Keep latest 7 folders and delete remaining folders Tag: 186543
  - 25
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186542
- Next
  - 1
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186539
  - 2
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186534
  - 3
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186531
  - 4
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186530
  - 5
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186528
  - 6
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186526
  - 7
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186523
  - 8
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186509
  - 9
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186504
  - 10
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186498
  - 11
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186491
  - 12
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186489
  - 13
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186472
  - 14
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186471
  - 15
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186470
  - 16
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186468
  - 17
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186467
  - 18
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186465
  - 19
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186463
  - 20
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186459
  - 21
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186456
  - 22
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186443
  - 23
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186441
  - 24
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186440
  - 25
    - 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: Keep latest 7 folders and delete remaining folders Tag: 186435

Hi Experts,

How do I write a VB script to keep the latest 7 folders and delete the
remaining folders ?

Thanks.

Re: Keep latest 7 folders and delete remaining folders by Larro

Larro
Thu Jan 26 02:04:51 CST 2006

That's tricky only because the folder property dates change whenever
they are accessed and if it was opened even to just look in the date
changes and you may lose something that you didn't want to.

Is there one specific file in each folder that can be read to determine
the date of the files contained within? Maybe one can be created just
for this purpose.

Once you get an accurate date the rest is relatively easy.

This will help you get started and we're here to help :)
http://www.microsoft.com/technet/scriptcenter/scripts/default.mspx

Larro
"Fixing the world one script at a time."

Top