Codeaholic's StandardLibrary.vbs

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
    - Help with Permission Denied Hi Folks, Need a hand here. I just got a new Car Stereo that takes SD cards, but the file format is WAY different than what Windows Media player synchs to the cards. I'm trying to read a .m3u playlist file and take each song and copy it to the SD card in a 8 character folder name of the play list. I keep getting "Permission Denied" errors. The music lives on a server in my house and I'm attempting to copy mp3 over the network to my SD card local to my client by double clicking on the .vbs file. Here is the script so far: (PS, it's not optimized, or cleaned up) ------ Set objFSO = CreateObject("Scripting.FileSystemObject") Dim PlayListName Dim SFNPlayListName Dim PlayListFile Dim SDCardDrive ' Changable Playlist Options PlayListName = "Driving Trax" PlayListFile = "\\server\Music\Playlists\Driving.m3u" SFNPlayListName = "DRVNG" SDCardDrive = "G:" 'Check to see if the target exists, if it does, delete it DestDir = SDCardDrive & "\" & SFNPlayListName If objFSO.FolderExists(DestDir) Then Set DelFolder = objFSO.GetFolder (DestDir) DelFolder.Delete End If 'Re create the folder and prep for copy Set MakeFolder = objFSO.CreateFolder(DestDir) Const ForReading = 1 Set plFile = objFSO.OpenTextFile(PlayListFile, ForReading) Do Until plFile.AtEndOfStream txtLine = plFile.ReadLine If Len(txtLine) <> 0 Then If Left(txtLine, 1) <> "#" Then 'Wscript.Echo ("Copy " & txtLine & " to " & DestDir) If ObjFSO.FileExists(txtLine) Then Set ws = WScript.CreateObject ("WScript.shell") ObjFSO.CopyFile txtLine, DestDir ' Permission Denied here! End If End If End If Loop plFile.close Wscript.Quit ----- I labelled the line I get permission denied on, I can't for the life of me figure out why, because if I take the commented "echo" line and copy and paste it into a CMD window, it works fine. Moreover, if I replace that permission denied line with: Call ws.run("cmd.exe /c copy " & Chr(34) & txtLine & Chr(34) & " " & DestDir & "\") It works fine (although it opens up about 80 CMD windows and freezes explorer until the copy is complete). Any idea why I'm getting permission denied here? Does the WSH block access to copy files (I was able to delete above?!?) or something? Thanks for the help! Sean Tag: Codeaholic's StandardLibrary.vbs Tag: 194877
  - 2
    - About create users and move them to appointed OU. Hi, everyone. I am going to create 10 users who names client 1 to client 10, and then move them to the appointed OU which names "SYS" I prepared 2 vbscripts. 1st: create 10 users: source code: Set objRootDSE = GetObject("LDAP://rootDSE") Set objContainer = GetObject("LDAP://cn=Users," & _ objRootDSE.Get("defaultNamingContext")) For i = 1 To 10 Set objLeaf = objContainer.Create("User", "cn=Client" & i) objLeaf.Put "sAMAccountName", "UserNo" & i objLeaf.SetInfo Next WScript.Echo "Users created." 2st: move them to OU (the name for ou is "SYS") Const ADS_PROPERTY_APPEND = 3 Set objRootDSE = GetObject("LDAP://rootDSE") Set objContainer = GetObject("LDAP://cn=Users," & _ objRootDSE.Get("defaultNamingContext")) Set objOU = objContainer.Create("OU", "cn=SYS") objOU.Put "sAMAccountName","SYS" objOU.SetInfo For i = 1 To 10 strDN = ",cn=Users," & objRootDSE.defaultNamingContext objOU.PutEx ADS_PROPERTY_APPEND, "member", _ Array("cn=UserNo" & i & strDN) objOU.SetInfo Next WScript.Echo "Users added to the OU." But , oh no, script failed. who can tell me what's wrong with "it" (I mean the script)? Thanks for everyone. Hope everything goes well with you. KejiaLi coming from China email: kejiali@gmail.com Tag: Codeaholic's StandardLibrary.vbs Tag: 194876
  - 3
    - Function help Hi, I have a stream which returns a value as shown below, 1190 Chris Grove 1058 GEORGE EVANS 1231 Susan D Elowson How do I return just the Numbers preceding the names? Any help is sincerely appreciated. Thx, Sunny Tag: Codeaholic's StandardLibrary.vbs Tag: 194875
  - 4
    - Local Account: PasswordLastChanged Anyone successful getting passwordlastchanged on local accounts? I can get this for domain accounts but the same vbs code (using the WinNT provider) doesn't seem to work for local accounts. TIA Dave Tag: Codeaholic's StandardLibrary.vbs Tag: 194871
  - 5
    - How to create a script to execute an application in the "Visual C++ 6" Hi, My objective is to execute an application that is in the directory of the open project. For in such a way i created this script: language="VBScript" function fnShellExecuteVB() dim objShell set objShell = CreateObject("Shell.Application") objShell.ShellExecute "notepad.exe", "", "", "open", 1 set objShell = nothing end function Sub test() fnShellExecuteVB End Sub In this script I am trying to execute notepad.exe as test and am receiving the following message from error: "Permission Denied" please, somebody knows what to make to execute an application in a macro in the "Visual c++ 6"? And how to obtain the directory of an open project? much thankful, helin Tag: Codeaholic's StandardLibrary.vbs Tag: 194869
  - 6
    - VB Script for RegEx file processing ' VB Script Document option explicit Dim objRegExpr Set objRegExpr = New regexp Dim InputFileName, OutputFileName, Result objRegExpr.Pattern = InputBox("Regex String :","RegEx","CUSTOMER TOTAL\s+=\s+[0-9\.]+") if ( objRegExpr.Pattern <> "" ) then ' for cancel. InputFileName = InputBox("Input file path and name :","Input File","y:\fix\roc\dated.txt") if ( InputFileName <> "" ) then ' for cancel. OutputFileName = InputBox("Output file path and name :","Output File","Regex.txt") if ( OutputFileName <> "" ) then ' for cancel. if ( MsgBox ( "Process file?", vbOKCancel, "Process") = vbOK ) then objRegExpr.Global = True objRegExpr.IgnoreCase = True Dim colMatches Dim objMatch Dim RetStr Dim objFSO,objFileRead,objFileWrite,strLine Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFileRead = objFSO.OpenTextFile(InputFileName, 1, false) Set objFileWrite = objFSO.CreateTextFile(OutputFileName) Do While objFileRead.AtEndOfStream = False strLine = objFileRead.ReadLine Set colMatches = objRegExpr.Execute(strLine) For Each objMatch In colMatches ' Iterate Matches collection. objFileWrite.WriteLine(objMatch.Value) Next Loop end if end if end if end if Wscript.Echo "Regex Done" Tag: Codeaholic's StandardLibrary.vbs Tag: 194868
  - 7
    - Permissions needed to query ROOT\MicrosoftExchangeV2? I have a script that queries mailboxes using: strComputer = ExchServer Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" & strComputer & _ "\ROOT\MicrosoftExchangeV2") ...but it is failing on GetObject with "permission denied". What permissions do I need to query MicrosoftExchangeV2? I've already given it full access on MicrosoftExchangeV2 via the WMI CPL. I've also made it an Exchange Admin. The only way I can get it to successfully query is making it a Domain Admin or Local Admin of the Exchange server. Thanks Trevor Tag: Codeaholic's StandardLibrary.vbs Tag: 194867
  - 8
    - change administrator password for all client in a domain I want make a script so that it can change all the adminitrator password of the clients in the domain. thank you Tag: Codeaholic's StandardLibrary.vbs Tag: 194861
  - 9
    - Rename a local user account via WMI or ADSI I am looking for any method to rename a local user account via WMI or ADSI or any other means that would be resident on W2K, WXP, W2K3, &&> -- Semper Fi, Red Please post to newsgroup only Tag: Codeaholic's StandardLibrary.vbs Tag: 194840
  - 10
    - email settings Is there a way to get the users email information from running a script on the users desktop, the info i need is email address mail server additional mail boxes if any shared calendars pst files Thank you Bob Tag: Codeaholic's StandardLibrary.vbs Tag: 194839
  - 11
    - VBscript to change excel cell values I need to open an excel spreadsheet and with a vbscript take the value in column 1 and parse it into column 2 and 3. Right now the spreadsheet only has this column 10.1.1.2/24 10.2.2.2/24 I need to run a script that will convert the spreadsheet into this format with 3 columns. 10.1.1.2/24 10.1.12 24 10.2.2.2/24 10.2.2.2 24 Would I use a script something like this: Option Explicit Dim strSheet, intRow Dim objExcel, objSpread Dim strComputer strSheet = "c:\test.xls" ' Open the Excel spreadsheet Set objExcel = CreateObject("Excel.Application") Set objSpread = objExcel.Workbooks.Open(strSheet) intRow = 2 'Row 1 often containes headings ' Here is the loop that cycles through the cells Do Until objExcel.Cells(intRow, 1).Value = "" strComputer = objExcel.Cells(intRow, 1).Value intRow = intRow + 1 Loop objExcel.Quit WScript.Quit What do I place in the loop to accomplish the copy paste and parse? Thanks for your help. Tag: Codeaholic's StandardLibrary.vbs Tag: 194835
  - 12
    - sendkey ENTER to a remote computer I need to send an enter key to a remote computer. I would prefer not having a vbscript on the remote if possible. I understand there are a few ways of doing this so any and all suggestion are welcome. I am running windows xp and need vbs code to sendkey ENTER to 50 computers on a network. I tried creating a file on the remote machine located at "C:\Script\SendEnter.vbs" to try and run remotely because i understand it is not possibly to sendkeys remotely but I cant seem to launch it. I was also thinking about dynamically creating script and running it on the the remote but I can't seem to get an application to run interactively on a remote machine either. this code works. On the remote machine, a "notepade.exe" process is running but there is no visible notepad to interact with. So I was unable to run a vbs file to send the Enter Key using this approach. strComputer = "RmoteMachine" Set objReg=GetObject( _ "winmgmts:{impersonationLevel=impersonate}!\\" & _ strComputer & "\root\CIMV2:Win32_Process") result = objReg.Create ("notepad.exe", null, null,procID) I have also tried the following which returns an activeX object error. set oController = CreateObject("WSHController") set oProcess = oController.CreateScript ("C:\Script\SendEnter.vbs", strComputer) oProcess.Execute While oProcess.Status <> 2 WScript.Sleep 100 WEnd WScript.Echo "Done" All I would like to do is send an ENTER key to an active popup window on a remote machine during a login. Thanks for your assistance. Tag: Codeaholic's StandardLibrary.vbs Tag: 194831
  - 13
    - WMI: Memory Type, Intel GMCH & ICH Are there WMI classes available that will report the following?: Memory Type (DDR, SDR, etc.) GMCH version/stepping (Intel Graphics & Memory Controller Hub) ICH version/stepping (I/O Controller Hub) Thanks, -- Bill Baker Tag: Codeaholic's StandardLibrary.vbs Tag: 194826
  - 14
    - Setting HTML based wallpaper? I've got a script that will set the wallpaper to an ActiveDesktop, HTML based wallpaper. I can set the wallaper, but without a reboot or opening the desktop properties and toggling the wallpaper choice, the settings don't apply immediately. If there a way to refresh the desktop or force a refresh programatically, and without having to pop up the desktop proeprties window? Here's my scritpt as it stands right now: '~~~~~~~~~~~~~~ BEGIN CODE ' Set the wallpaper path WP = "%SystemRoot%\Web\Wallpaper\ActiveWallpaper.html" ' Edit the registry to set the wallpaper choice Set objShell = CreateObject("WScript.Shell") objShell.Regwrite "HKCU\Control Panel\Desktop\WallPaper", "" objShell.Regwrite "HKCU\Control Panel\Desktop\TileWallPaper", 0 objShell.Regwrite "HKCU\Control Panel\Desktop\WallPaperStyle", 0 objShell.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\WallPaper", "" objShell.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\TileWallPaper", 0 objShell.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\WallPaperStyle", 0 objShell.Regwrite "HKCU\Software\Microsoft\Internet Explorer\Desktop\General\WallPaper", WP objShell.Regwrite "HKCU\Control Panel\Desktop\WallPaper", WP ' Open the Desktop Properties window and toggle/apply to force the desktop objShell.Run "control desk.cpl" WScript.Sleep 300 objShell.AppActivate "Themes" WScript.Sleep 300 objShell.SendKeys "{tab}" WScript.Sleep 300 objShell.SendKeys "{tab}" WScript.Sleep 300 objShell.SendKeys "~" Set objShell = nothing '~~~~~~~~~~~~~~ END CODE Obviously, I'd like to apply the wallpaper without rebooting or having to mess with the desktop properties window. Any help would be greatly appreciated! Tag: Codeaholic's StandardLibrary.vbs Tag: 194818
  - 15
    - Adjust computer discription from Excel to Active directory I want to update computers description using an excell with the computername and the discription. new discription should be added behind any existing description for the computer in Active directory. this is the code i have but i'm stuck: Dim Row As Integer Dim oUser As IADsUser Dim oComp As IADsComputer Dim HowMany As Integer Set RootDse = GetObject("LDAP://RootDSE") DomainContainer = RootDse.Get("defaultNamingContext") 'Set oOU = GetObject("LDAP://OU=Test,OU=EU Users,DC=EU,DC=qplas,DC=com") Set conn = CreateObject("ADODB.Connection") conn.Provider = "ADSDSOObject" conn.Open "ADs Provider" Row = 2 HowMany = 0 Do Until Cells(Row, 1) = Empty Name = Trim(Cells(Row, 1).Value) Description = Trim(Cells(Row, 2).Value) 'Construct an LDAP query to Active Directory looking for users with the specified attributed, 'first name, last name, address, etc. 'LDAPStr = "<LDAP://" & DomainContainer & ">;(&(objectCategory=user)(givenName=" & gname & ")(sn=" & sname & ")(streetaddress=" & mailingaddress & ")(l=" & city & "));adspath;subtree" ldapstr = "<LDAP://" & DomainContainer & ">;(&(objectCategory=computer)(Name=" & Name & "));adspath;subtree" Set RS = conn.Execute(ldapstr) If RS.RecordCount > 0 Then Set oComp = RS.Fields(0) If Description <> "" Then tmpDiscription = oComp.Get("Description") finaldiscription = tmpDiscription + " - " + Description oComp.Put "Description", finaldiscription End If oComp.SetInfo HowMany = HowMany + 1 Else MsgBox Name & " Not found" End If Set oComp = Nothing Set RS = Nothing Row = Row + 1 Loop MsgBox HowMany & " computers updated" End Sub code blocks when here: Set oComp = RS.Fields(0) i can't get my computer object out of the Recordset. Tag: Codeaholic's StandardLibrary.vbs Tag: 194809
  - 16
    - XML Help In my VB script I generate an XML object which has XML of the form (see below). It has to be like this as I get the XML from an API What I need to next in my ASP page is parse the XML in name value pairs - however I need to sort on the 1st value e.g I need something like this 5 65-MOV-317 5 65-MOV-318 5 65-MOV-319 5 65-MOV-330 5 66-MOV-317 3 65-MOV-001 3 65-MOV-002 3 65-MOV-003 3 65-MOV-331 3 66-MOV-315 etc..... I haven't a clue how to achieve this, please any help would be greatfulyl recieved <Report> - <Row> - <Column> <Value>1</Value> </Column> - <Column> <Value>65-MOV-317</Value> </Column> </Row> - <Row> - <Column> <Value>5</Value> </Column> - <Column> <Value>65-PV-636</Value> </Column> </Row> - <Row> - <Column> <Value>5</Value> </Column> - <Column> <Value>65-RV-113</Value> </Column> </Row> - <Row> </Report> Tag: Codeaholic's StandardLibrary.vbs Tag: 194808
  - 17
    - Can you create a timed loop? I am attempting to shorten the default timeout period when mapping a network drive via a logon script (useful when the server is down) from the default of 45-50 seconds to 10 seconds. Users with a dozen or more mappings affected like this can end up waiting 10+ minutes for the logon script to complete. Does anyone know a way to do this in VBScript? (NOTE: I don't want to go the one size fits all setting, a timeout on the whole script via Properties > Script > Stop script after specified number of seconds.) i.e. Do (loop for up to the next 10 seconds while waiting for this operation to complete) objNet.MapNetworkDrive L:,\\srvname\share Loop -Chris Tag: Codeaholic's StandardLibrary.vbs Tag: 194801
  - 18
    - Issue with users losing rights to their registry (Script help) Hello all. I been having an issue with users that logon to terminal services losing permissions in the registry. To try to narrow it down to a specific server an trying to write a logoff script that tries to write a value to the registry and logs the server, user and time that the error occurs. The issue is that I cannot trap the error using regWrite.. is there a better way... Or a way I can through a script verify if a user has rights to their hive on logoff.. Any help would be awesome.. Here is what I have so far. Set sho = CreateObject("Wscript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") Set nwo = CreateObject("WScript.Network") If Not fso.FolderExists("c:\applog") Then fso.CreateFolder("c:\applog") End If 'Set outFile = fso.CreateTextFile("\\GO001W2K037\profiles4\HiveLog\Hivelog.txt",8) If Not not fso.FileExists ("C:\Applog\Hivelog.txt") Then Set outFile = fso.CreateTextFile("C:\Applog\Hivelog.txt",8) Else Set outFile = fso.openTextFile("C:\Applog\Hivelog.txt",8) End If strMachineName=sho.expandenvironmentstrings("%computername%") strUserName=sho.expandenvironmentstrings("%username%") Checkit=sho.RegWrite("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\ICANDOIT",0,"REG_DWORD") If Checkit <> 0 Then outFile.Writeline (VbCrLf) outFile.Writeline ("User: " & strUserName & VbCrLf & "Server: " & strMachineName & VbCrLf & "Time: " & Now) End If outFile.Close WScript.Quit Tag: Codeaholic's StandardLibrary.vbs Tag: 194798
  - 19
    - Insert Data I try to insert some data in my table name customer(Customer_Name, Street, Account_No) from data: [Customer's Name] [Street] [Account Number] How to i do that needs help ----------------------------------------------------- Set con = Server.CreateObject("ADODB.Connection") sConnection ="Provider=MSDASQL.1;Persist Security Info=False;Data Source=emp1" con.Open(sConnection) Function EnumerateFolder( sFolder ) Dim fso, ts, data Set fso = CreateObject("Scripting.FileSystemObject") Set fol = fso.Getfolder ( server.mappath(sfolder) ) For each fil in fol.files Set customer = CreateObject("Scripting.Dictionary") Set ts = fil.openastextstream(1) ary = Split(ts.ReadAll(),"[") ts.Close For i = 1 to Ubound(ary) data = Split(ary(i),"]") customer.Add data(0), data(1) Next next End Function EnumerateFolder "c:\txt" Function test(s) Select Case s Case "[Dat" test = True Case "[Nov" test = True Case "[Sub" test = True Case "[Cus" test = True Case "[Str" test = True Case "[Cit" test = True Case "[Acc" test = True Case "[Ins" test = True Case "[Las" test = True Case "[PPV" test = True Case "[Mon" test = True Case "[Cur" test = True Case "[Typ" test = True Case "[Lan" test = True Case "[CRC" test = True Case "[Eve" test = True Case "[Sum" test = True Case "[Box" test = True Case "[MD" test = True Case "[Con" test = True End Select End Function -----SAMPLE DATA----- [Date] Sat Aug 05 14:06:12 EDT 2006 [Novell ID] NSMITH4 [Subject] PPV / VOD Research - Dispute - 1st Time - 711579 [Customer's Name] EDWARD CAMPBELL [Street] 5 WHEELER AVE APT 2 [City, State, Zip] BRIDGEPORT CT, 06606 [Account Number] 006-0416-08 [Install Date] 06/21/2001 [Last Known Event Date] 06/29/2006 [PPV Hold] No [Monthly Rate] 186.52 [Current Services] Optimum Voice OOL FamilyorAbv OR$20Discount iO Silver Pkg iO Box PPOF Addset: C/Rdy OV World Call OV Ported Number [Type of Request] Dispute - 1st Time [Language] English [CRC PIN Instructions] Yes [Event Numbers/Date Range] #77922 6/29, #78306 6/29, #77716 6/28, #77312 6/28 [Summary] cust states that they and no one in the household ever ordered those ppv movies.cust requesting credit of $35.80. [Box Verification by Customer] 2,SABKDTHBF,Yes,Yes,Yes,Yes [MD Page ID] 1 [Control Number] 651789 Tag: Codeaholic's StandardLibrary.vbs Tag: 194797
  - 20
    - Help with cancelling a meeting with webdav I don't get it, what am I missing here? It sends the meeting no problem, but not as a canclled meeting, and it does remove the meeting from the calendar, but the sent e-mail is not cancelled. Any ideas? Set XMLreq = CreateObject("Microsoft.xmlhttp") XMLreq.open "PROPPATCH", oField, False, sDomain&sUserName, sPasswd xmlstr = "<?xml version=""1.0""?>" _ & "<g:propertyupdate "_ & " xmlns:g=""DAV:"" "_ & " xmlns:e=""http://schemas.microsoft.com/exchange/"" "_ & " xmlns:mapi=""http://schemas.microsoft.com/mapi/"" "_ & " xmlns:mapit=""http://schemas.microsoft.com/mapi/proptag/"" "_ & " xmlns:x=""xml:"" xmlns:cal=""urn:schemas:calendar:"" "_ & " xmlns:dt=""urn:uuid:c2f41010-65b3-11d1-a29f-00aa00c14882/"" "_ & " xmlns:header=""urn:schemas:mailheader:"" "_ & " xmlns:mail=""urn:schemas:httpmail:""> "_ & " <g:set> "_ & " <g:prop> "_ & " <g:contentclass>urn:content-classes:calendarmessage</g:contentclass> "_ & " <e:outlookmessageclass>Ipm.Schedule.Meeting.Canceled</e:outlookmessageclass> "_ & " <e:x-priority-long dt:dt=""int"">2</e:x-priority-long> "_ & " <mail:subject>"&oRs.Fields("urn:schemas:httpmail:subject").value&"</mail:subject> "_ & " <mail:htmldescription>User Termination, Meeting Cancelled: "&oRs.Fields("urn:schemas:httpmail:subject").value&"</mail:htmldescription> "_ & " <header:cc>"&ccfield&"</header:cc> "_ & " <header:bcc>"&bccfield&"</header:bcc> "_ & " <header:to>"&tofield&"</header:to> "_ & " <cal:meetingstatus>CANCELLED</cal:meetingstatus> "_ & " <cal:dtend dt:dt=""dateTime.tz"">"&endtime&"</cal:dtend> "_ & " <cal:dtstart dt:dt=""dateTime.tz"">"&starttime&"</cal:dtstart> "_ & " <cal:alldayevent>"&isallday&"</cal:alldayevent> "_ & " <cal:busystatus>"&oRs.Fields("urn:schemas:calendar:busystatus").value&"</cal:busystatus> "_ & " <cal:method>CANCEL</cal:method> "_ & " <cal:instancetype dt:dt=""int"">"&oRs.Fields("urn:schemas:calendar:instancetype").value&"</cal:instancetype> "_ & " <cal:responserequested dt:dt=""boolean"">0</cal:responserequested> "_ & " <cal:removefromcalendar dt:dt=""boolean"">1</cal:removefromcalendar> "_ & " <cal:uid>"&oRs.Fields("urn:schemas:calendar:uid").value&"</cal:uid> "_ & " <mapi:appstateflags dt:dt=""int"">7</mapi:appstateflags> "_ & " <mapi:finvited dt:dt=""boolean"">1</mapi:finvited> "_ & " <mapi:responsestatus dt:dt=""int"">1</mapi:responsestatus> "_ & " <mapi:responsestate dt:dt=""int"">0</mapi:responsestate> "_ & " <mapi:response_requested dt:dt=""boolean"">0</mapi:response_requested> "_ & " <mapi:busystatus dt:dt=""int"">0</mapi:busystatus> "_ & " <mapi:intendedbusystatus dt:dt=""int"">0</mapi:intendedbusystatus> "_ & " </g:prop> "_ & " </g:set> "_ & " </g:propertyupdate> " Tag: Codeaholic's StandardLibrary.vbs Tag: 194786
  - 21
    - Case Select, Printers comparing IP addresses Hi All, I interested in a small project. I have a vbscripts to find the IP address of the local machine. I would like the 3rd octet of the IP to be compared to a list using Case Select to allows users to choose printers avaliable in their own building. IP is detected 3rd Octet is stored in a variable That varible becomes one of the Case Select choices The Case Select then presents a list of available printers. Any Ideas? Tag: Codeaholic's StandardLibrary.vbs Tag: 194777
  - 22
    - Session Variables in Firefox Hello, I am using ASP/VBScript. For some reason, Firefox will not pass my session variables, while IE and Netscape will. I can't imagine what's wrong. I was able to recreate the problem with the two test pages below. I tested these pages in the three aformentioned browsers: FFTEST1.ASP <html> <head> <meta http-equiv="Content-Language" content="en-us"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>Page 1</title> <meta name="GENERATOR" content="Microsoft FrontPage 6.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> </head> <body> <% Session("fftest") = "Hello!" %> <p><a href="fftest2.asp">Go to second page >>></a></p> </body> </html> FFTEST2.ASP <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>Page 2</title> <meta name="GENERATOR" content="Microsoft FrontPage 6.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> </head> <body> <% = Session("fftest") %> </body> </html> What could the problem possibly be? Thanks for any help you can give. Chris Smith Tag: Codeaholic's StandardLibrary.vbs Tag: 194776
  - 23
    - Login Alias This there a WMI 32 class that can get the current login alias, I want to make a text file with the alias. I currently use the script below to open a text file. strComputer = "." Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.CreateTextFile("c:\software.tsv", True) Tag: Codeaholic's StandardLibrary.vbs Tag: 194775
  - 24
    - How to run a Script using the System account I'm trying to run a script to find out the ACL for all the folders on oneof my file servers, but since I also dont have access on some of the folders like finance and HR, the script fails. The only way I can think of without changing the permissions on the HR and Finance folders is to run the script using the builtin SYSTEM account. If anybody know how to run a script using the system account, please let me know. Cheers Arvind Tag: Codeaholic's StandardLibrary.vbs Tag: 194769
  - 25
    - Open Folder Location Using HTA I've never had a problem opening a folder location until this one. The location I want to open is: C:\Documents and Settings\%username%\Local Settings\Temporary Internet Files The two methods I would typically use are below. Set objShell = CreateObject("Wscript.Shell") objShell.Run "C:\Documents and Settings\%username%\Local Settings\Temporary Internet Files" -- OR -- Set objShell = CreateObject("Wscript.Shell") ShellRun = objShell.Run ("%comspec% /c Start "C:\Documents and Settings\%username%\Local Settings\Temporary Internet Files", 0, 1) I understand its due to the spacing in Temporary Internet Files as the path can be written: C:\DOCUME~1\tmaynard\LOCALS~1\Temporary Internet Files. I either need an environmental variable I've overlooked, a way to include spaces (all my attempts at single quotes don't work) or another method all the way around. Thanks, Tommy Tag: Codeaholic's StandardLibrary.vbs Tag: 194768
- Next
  - 1
    - mssqlserver scripting Does anyone know if there is a scripting object that allows you to interface with Microsoft SQL Server? I would like to query such things as the number of SQL instances, and the location of their logfiles. A similar object to the one for IIS (IIS://LocalHost/W3svc) would be ideal. Many thanks, Neil Tag: Codeaholic's StandardLibrary.vbs Tag: 194767
  - 2
    - Variable not being passed Hello, I'm hoping someone can help me with this. We have change all our login scripts to vbscripts instead of batch files. All works great except on two machines. They get an error saying cannot find netlogon because the script has strDomainServer =%logonserver%\netlogon on one of the lines. The thing is, I can do a Start-Run %logonserver%\netlogon and it opens the folder on the domain controller just fine. I changed the script to strDomainServer =\\"mydomain.com", but that won't work either, but I think it might be getting hungup on a different variable now. For whatever reason, it doesn't appear that the machine can pass the variable info on (ie. computer name, user name). Does anyone have any suggestions? I could reformat the machines, but would rather fix the problem. Thanks! Tag: Codeaholic's StandardLibrary.vbs Tag: 194762
  - 3
    - Help needed for a script Hi, I need some help for writing a script. My problem is this. I have a pile of 200 or so floppy disks. I have to get all the contents from each disk into a separate folder on a hard drive. I have looked at the floppies some of them have Volume names and some of them don't. I would like to keep the volume name if it exists and use it for naming the folder. I suspect that maybe some od the floppies have identical volume names and so I mus t have away to differenciate between any two floppies (and folders) which would have the same name. I think that adding a timestamp to the name of the folder would be OK. I have looked at the floppies - again - some of them have viruses !! and some of them don't. So this is what I'd like to do. 1. Put the floppy in the floppy drive. 2. Click on a vbscript that would Read the voulume name Run my AV programme to scan for viruses and let me deal with any bad things Make a new unique folder on the hard drive XCopy a:\*.* /s with all subfolders and hidden and system files to the new unique folder. Give me a yell when it's done! 3. Ask for anew floppy and start over again Maybe I should deal with the viruses first and then run a simpler script that would just copy ? Anyway, any help appreciated. TIA AMD Tag: Codeaholic's StandardLibrary.vbs Tag: 194760
  - 4
    - Wscript.Shell Issue Hi, I use the following vbscript for opening the documents in their respective exe's i.e., a .doc file in WINWORD.exe and a.txt file in Notepad.exe. <script language=VBScript> Sub ShowFiles(fileLink) Set objShell = CreateObject("Wscript.Shell") objShell.Run fileLink End Sub </script> fileLink - The path comes from the Database For this script to work properly, I have enabled the ActiveX controls settings in the Internet Explorer - Tools options. As per our design, on the click of an image that lies next to the document name column in a Datagrid, the document should open in the intended exe. But this does not happen all the time. Sometimes it opens the document but most of the time it throws a script error as "The System cannot find the specified file path.". But if I take the path from "View Source" property and place it in the "Run Window" I am able to access the file. Please help me in resolving this issue. Thanks in advance. -- Samba! Tag: Codeaholic's StandardLibrary.vbs Tag: 194757
  - 5
    - Local groups that user belongs to Hello! I need a script, that will list me all user and groups, that he belongs to. But in special way: user1 group1 group2 group3 user2 group1 group2 etc I have this script, but i don't know how to change it.... :( Set colGroups = GetObject("WinNT://.") colGroups.Filter = Array("group") For Each objGroup In colGroups For Each objUser in objGroup.Members If objUser.name = "test" Then Wscript.Echo objGroup.Name End If Next Next Anyone help me? Tag: Codeaholic's StandardLibrary.vbs Tag: 194751
  - 6
    - execute a file from vbscript hello to all. how can I execute a file (file.cmd or file.bat, or another) from vbscript? thank you in advance. greetings.. Scorpion. Tag: Codeaholic's StandardLibrary.vbs Tag: 194750
  - 7
    - Fill the field... Hi. I wonder if it is possible to resolve my task with only VBScript. I want to add to IE context menu an item wich fill any field in web-page with some text. Through my little research I've discover how I can add the "fill text" to context menu wich point to any script file i wosh. But I can't realise how to write this script =( I'm very new to scriupting, so I'd be very appreciated if someone helped me. -- Regards, Alexander Trofimov Tag: Codeaholic's StandardLibrary.vbs Tag: 194749
  - 8
    - ASPX, VBScript, JavaScript, Double-Underscored Variables and setTimeOut That subject packs a whallop, so let me explain in better detail what's happening and how it relates to ASPX pages... In a [large] nutshell, if the first <script /> on a page is of type "text/vbscript", you cannot use inline JavaScript statements that call setTimeout with functions that start with a double-underscore. This is very relavant to ASPX (ASP Dot Net) pages because it means that AutoPostBacks will fail since they generally call the famous JavaScript statement "__doPostBack(...)" via a setTimeout call. If you include a VBScript code block before any other code block on an ASPX page, the following statement will fail in IE (and the error is far from obvious since it is untrappable and says only that there is an Invalid character on line 1, character 2): "javascript:setTimeout('__doPostBack(\'anyASPXcontrol\',\'\')', 0)" This is a bug in IE 6 and possibly earlier versions (I only have v6 to play with.) I do not know if it affects IE 7 as I have not installed that for testing lately. Note that even though the prefix of "javascript:" is used, the setTimeout function assumes it's calling a VBScript function, presumably because the first script block is a VBScript block. Here is a very simple page that shows this bug: http://www.digitolle.net/news/testscriptbug.htm and here is the source code: -------- <html> <head> <title>Test Script Bug</title>  <script type="text/vbscript"> ' Just because this VBScript block exists, ' setTimeout uses VBScript naming conventions. ' Therefore, double underscore functions will fail ' Rem this block out, and both buttons will work ' Note that calling the function directly always works. </script> </head> <body> <script type="text/javascript"> function __x() { alert("test"); } </script> <input type="button" value="This will Work" onclick="javascript:__x();" /> <br /> <input type="button" value="This will Fail" onclick="javascript:setTimeout('__x()', 0);" /> </body> </html> -------- The obvious workaround is to always include a JavaScript block before any VBScript blocks, even if it's just an empty block. If anyone else comes up with the same results on this test, please let me know. Of course if this is a known issue and I'm beating a dead horse, again, please let me know because it's an odd issue to look up and it's definitely a brain stumper if you don't know it exists. Tag: Codeaholic's StandardLibrary.vbs Tag: 194745
  - 9
    - RegExp Prob Hi, I try to achieve the following and have some probs with the REGEXP. I read a text file into an array, and look for part of a string , like 'AAAA' , I know that there are 2 instances of this string in the file. The found string itself looks like 'AAAA1234' where AAAA can be any A-Z , and 1234 any numeric sign. I have to replace this found instances 'AAAA' with 'BBBB9876' f.ex Problem is , that sometimes there can be 3 digits or 4, so I wanted to use a regexp , to find the numeric values and replace them. How to do this ? (I can post the script, if that helps) thx for any suggestion. -- Rom Tag: Codeaholic's StandardLibrary.vbs Tag: 194743
  - 10
    - How to create text file based on variable name. Hi All, I'm trying to create a text file based on the results of a command. Here is my code snippet: Set WshShell = CreateObject("WScript.Shell") Set logdir = WshShell.Exec("%comspec% /c echo %mydir%\log\monitor.log") logName = logdir.stdout.readall() wscript.echo logName Set FSOLog = CreateObject("Scripting.FileSystemObject") Set logfile = FSOLog.CreateTextFile(logname, True) The results of logName shows the real value of my directory: e:\program files\my company\users\my username\log\monitor.log but I get a run-time error that says "bad file name or number" for the CreateTextFile line. Any thoughts on how to do this? Regards, sggrimes Tag: Codeaholic's StandardLibrary.vbs Tag: 194741
  - 11
    - logging when launched from current version\Run I have a couple vbs scripts using wscript that run on a timed loop the monitor processes and data records. When I run them manually I am able to log progress using objFSO.OpenTextFile("./xxx.log", ForAppending, True). However, when I add these to the registry Windows\Current Version\Run key to launch at logon, they function, but the logging fails. I imagine this has to do with runas permissions. How can I work around that? Tag: Codeaholic's StandardLibrary.vbs Tag: 194738
  - 12
    - logging when launched from current version\Run I have a couple vbs scripts using wscript that run on a timed loop the monitor processes and data records. When I run them manually I am able to log progress using objFSO.OpenTextFile("./xxx.log", ForAppending, True). However, when I add these to the registry Windows\Current Version\Run key to launch at logon, they function, but the logging fails. I imagine this has to do with runas permissions. How can I work around that? Tag: Codeaholic's StandardLibrary.vbs Tag: 194737
  - 13
    - Shortcut target issue Hello, I have a shortcut that I created for a secured Access(2002) DB. In order to keep people from having to join the workgroup associated, it's recommended that you create a shortcut and use the /wrkgrp switch in the target. My target line in the shorcut looks like this: "C:\Program Files\Microsoft Office\Office10\MSACCESS.EXE" "C:\Documents and Settings\AllUsers\Desktop\Databases\SecSCM_DB.mdb" /wrkgrp "S:\SCM\Private\SCM_DB\Datafiles\Secured.mdw" My problem is that I have discovered about 10 different paths to the Access.exe on different PC's on the network. Each time I tell someone to copy the shortcut to their desktop, I get a call stating that it doesn't work and I end up having to make a trip to someone's desk to manually change the target. 1. Can't a script be written to determine the path to the .exe on a client pc? 2. Can the script be run from the server, do the above and place a shortcut on the users desktop with the correct path to the exe and keep the db file and switch part of the target intact? Ultimate goal is to just have anybody who wants this database to be able to nav to the server, click on the script and a shortcut is placed on their desktop for them. All of the PCs have Windows XP. Just different versions of Office installed. I read a thread that was similar to this but the links to the answers did not work for me. So I don't know if it answers my question. Thanks for any help on this. Tag: Codeaholic's StandardLibrary.vbs Tag: 194736
  - 14
    - Script to create a network folder shortcut on the desktop HELP! I have looked everywhere. I cannot believe that I cant find a script to place a shortcut to a network folder on the users desktop. All of my own attempts have failed, as I am pretty lousy at scripting. Any help would be VERY much appreciated! THANKS! Tag: Codeaholic's StandardLibrary.vbs Tag: 194729
  - 15
    - msgbox problem Here is my code: On Error Resume Next command.execute 'check if error occurred If Err.Number <> 0 Then errmsg = MsgBox( "0x" & hex( Err.Number ) & " " & Err.Description, 64+0, "Damn" ) document.write( errmsg ) 'destroy database objects DestroyDatabase connect, command, recordset Response.Redirect URL_HOME End If On Error Goto 0 Now, the redirect does work, I notice that happening, but my question is: Why doesn't the msgbox display? Thanks Jeremiah Tag: Codeaholic's StandardLibrary.vbs Tag: 194727
  - 16
    - script to list all computer accounts I need a script to give me a total number of computer accounts. Does anyone have this? Thanks Tag: Codeaholic's StandardLibrary.vbs Tag: 194725
  - 17
    - im almost an MVP has anyone else noticed that i post a problem (with a fake name), then post the solution (with this name), then reply saying "thank you, you solved it for me" (with the fake name again)?? LOL... Babu, seriously, get a friggin life. youre pathetic Tag: Codeaholic's StandardLibrary.vbs Tag: 194724
  - 18
    - Calculating backup size The company I work for uses NT Backup to backup data to removable hard drives. We would like to save more than one bkf file to a backup drive, instead of overwriting the existing backup. I am writing a vb script which will delete the oldest bkf file(s) on the drive to ensure that there is sufficient free space on the drive to write the latest backup. I would like to know if it's possible to calculate the size of the next backup based on the backup specification (bks) file used by NT Backup. Tag: Codeaholic's StandardLibrary.vbs Tag: 194723
  - 19
    - script to create sites and services subnets Ok can anyone give me some help here........ I have managed to get the script to create the subnets by reading a CSV file but for some reason when I execute the script it fails at the "objSubnet.SetInfo" line and I can't figure out why... Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Const WAIT_ON_RETURN = True Const HIDE_WINDOW = 0 Dim InFile, OutFile, objFSO, objShell, fsin, fsout, arrLine, RArray,FolderPath Dim strSubnetRDN, strSiteObjectRDN, strDescription, strLocation, Status, folderSize, ComputerCount InFile = "c:\temp\sitessubnets.csv" ComputerCount=0 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objShell = WScript.CreateObject("Wscript.Shell") Set fsin = objFSO.OpenTextFile(InFile, ForReading, True) Do while Not fsin.AtEndofStream arrLine = SplitCSV(fsin.ReadLine) strSubnetRDN = arrLine(0) strSiteObjectRDN = arrLine(1) strDescription = arrLine(2) strLocation = arrLine(3) Set objRootDSE = GetObject("LDAP://RootDSE") strConfigurationNC = objRootDSE.Get("configurationNamingContext") strSiteObjectDN = strSiteObjectRDN & ",cn=Sites," & strConfigurationNC strSubnetsContainer = "LDAP://cn=Subnets,cn=Sites," & strConfigurationNC Set objSubnetsContainer = GetObject(strSubnetsContainer) Set objSubnet = objSubnetsContainer.Create("subnet", strSubnetRDN) objSubnet.Put "siteObject", strSiteObjectDN objSubnet.Put "description", strDescription objSubnet.Put "location", strLocation objSubnet.SetInfo Loop Function SplitCSV(sCSVLine) Dim bQuote, aCSVLine, x Redim aCSVLine(0) bQuote = False For x = 1 to Len(sCSVLine) Select Case True Case bQuote And Mid(sCSVLine, x, 1) = """" bQuote = False Case Mid(sCSVLine, x, 1) = """" bQuote = True Case Not bQuote And (Mid(sCSVLine, x, 1) = ",") Redim Preserve aCSVLine(UBound(aCSVLine) + 1) Case Else aCSVLine(UBound(aCSVLine)) = aCSVLine(UBound(aCSVLine)) & Mid(sCSVLine, x, 1) End Select Next SplitCSV = aCSVLine Any help would be appreciated.......... cheers Tag: Codeaholic's StandardLibrary.vbs Tag: 194716
  - 20
    - Help!! Hey.. I'm running some vba code to change a certain sheet accordingly to some information. This sheet then should be faxed to a certain client, the problem is that Every sheet differs to their respective client and ther's 500 clients. How will I be able to send every sheet to it's respectible customer, with the click of one button? I can already print every sheet with the specific information, but how will I fax it without having to enter the details of 500 people, can I use a vbscript file and how do I do that? Tag: Codeaholic's StandardLibrary.vbs Tag: 194715
  - 21
    - How can I suppress window update during macro execution in VS6.0? I am using Visual Studio 6.0. On occasion I have to do major edits to large text files, and I find the easy way to do multiple edits is to create vbscripts. Is there a way to "turn off" screen update while it processes the file. There's time being consumed there and when I have a multimegabyte file being processed, it is a lot of time. Example code for processing a file dump. This macro trims off the end of the line at the vertical bar and deletes the eol to bring the next line up. The file is the form: ff ff ff ff ff ff ff ff ff ff ff ff ff ff ff ff | ascii stuff here --------------- ' preceding code snipped for x = 1 to 32 ' number of lines to concatenate if (ActiveDocument.Selection.FindText("|", dsMatchRegExp)) then ActiveDocument.Selection.CharLeft ActiveDocument.Selection.EndOfLine dsExtend ActiveDocument.Selection.Delete 2 else findfailed = true exit do 'there is an outer infinite loop that this exits end if next 'x ' subsequent code snipped -------------- This is just an example, but the effect when it is running is the thumbs on the scrollbars move as the file is processed and the entire visual area of the screen is constantly moving and flashing as the edits are done. Can I turn off this display update for the duration of the macro run? The only action of interest is the vertical scroll bar, because that would be useful as a progress bar. But other than that, the visual updates are just a waste of everyone's time. Thanks! Rufus Tag: Codeaholic's StandardLibrary.vbs Tag: 194714
  - 22
    - Launch an HTA from .VBS file The below code will open my HTA app from RUN. What would the syntax be to open my HTA from inside a .VBS file? CODE ********* c:\windows\system32\mshta.exe "c:\data\my_utility.hta" Tag: Codeaholic's StandardLibrary.vbs Tag: 194713
  - 23
    - GENERAL QUESTION Hello all, I've built several sites where the administrator can login and inser or update records. I am now building a site that will allow lots of people to be inserting and updating records. Am I going to run into conflicts when 2 or more people attempt to do this at the same time into the same table? I'm using vbscript and mySql. Thanks. MG Tag: Codeaholic's StandardLibrary.vbs Tag: 194711
  - 24
    - Macro creating second chart but I only need 1 - HELP I'm not too familiar with VB, and I'm trying to narrow down why my macro (and how) is creating a second, duplicate chart. I only need the chart to be created (and the corresponding data fields on the 3rd worksheet) once. If anyone can help me to understand where in the code I should be looking, I'd greatly appreciate it! Thank you, Stephanie below is my coding: Public strControlTitle As String Public strControlTime As String Public strControlUnit As String Public intControlItem As Integer Public intLastNameOnly As Integer Public intDataType As Integer Sub Main() Dim strControlItem, strPageName, strValue, sigma, z95, z99 As String Dim r, c, count, cmax, rmax, rt, ct, low, high, a, b As Integer Dim lesscol As Integer With ControlChartForm .ComboBox1.AddItem ("Average Turn Around Time All Patients") .ComboBox1.AddItem ("Average Turn Around Time Discharged Patients") .ComboBox1.AddItem ("Average Turn Around Time Admitted Patients") .ComboBox1.AddItem ("Charges Per Hour") .ComboBox1.AddItem ("Admission Percentage") .ComboBox1.AddItem ("Average Press Ganey Raw Score - Physician Questions Only") .ComboBox2.AddItem ("Average TAT (in minutes)") .ComboBox2.AddItem ("Charges (in dollars)") .ComboBox2.AddItem ("Admissons %") .ComboBox2.AddItem ("Average Score") End With Load ControlChartForm ControlChartForm.Show If intControlItem = 1 Then strControlItem = "Physician" Else strControlItem = "Physician" If Range("A1").CurrentRegion.Columns.count = 2 Then ActiveSheet.Range("A:A").Insert (xlShiftToRight) Range("A1").Value = "All Hospitals" End If End If ActiveSheet.Name = "Raw Data" If InStr(Range("A2").Value, "---") > 0 Then _ ActiveSheet.Rows(2).Delete Worksheets.Add.Move after:=Worksheets("Raw Data") Worksheets(Worksheets.count).Name = "Chart Data" With Columns(1) .WrapText = True .VerticalAlignment = xlVAlignCenter .HorizontalAlignment = xlHAlignCenter End With Worksheets("Raw Data").Activate Range("a1").CurrentRegion.Select With Selection .Replace _ What:="RW Johnson", _ Replacement:="ROBERT WOOD JOHNSON" '************************************************* 'Add known spelling or formatting errors in the space below 'Use the following format: ' ' .Replace _ ' What:="Text to replace" ' With:="Replacement text" '************************************************* End With ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _ Selection, TableDestination:=Worksheets("Chart Data").Range("a1"), TableName:="ChartData", RowGrand:=True ActiveSheet.PivotTables("ChartData").AddFields RowFields:=Worksheets("Raw Data").Range("a1").Text, ColumnFields:=Worksheets("Raw Data").Range("b1").Text addtotable = True If intDataType = 0 Then With ActiveSheet.PivotTables("ChartData").PivotFields(3) .Orientation = xlDataField .Name = "Admissions %" .Position = 1 .Function = xlAverage End With With ActiveSheet.PivotTables("ChartData").PivotFields(3) .Orientation = xlDataField .Name = "Patients Seen" .Position = 2 .Function = xlCount End With Else With ActiveSheet.PivotTables("ChartData").PivotFields(3) .Orientation = xlDataField .Name = "Count of " & strValue .Position = 1 .Function = xlCount End With With ActiveSheet.PivotTables("ChartData").PivotFields(3) .Orientation = xlDataField .Name = "Average of " & strValue .Position = 2 .Function = xlAverage End With With ActiveSheet.PivotTables("ChartData").PivotFields(3) .Orientation = xlDataField .Name = "StdDev of " & strValue .Position = 3 .Function = xlStDev End With End If r = 3 c = 3 cmax = ActiveSheet.PivotTables("ChartData").ColumnFields(1).PivotItems.count rmax = ActiveSheet.PivotTables("ChartData").RowFields(1).PivotItems.count + 1 rt = (2 + intDataType) * (rmax + 3) ct = 3 For i = 1 To rmax ct = 3 Worksheets("Chart Data").Activate Range(Cells(rt, 1), Cells(rt + 7, 1)).Merge If Trim(Cells(r, 1).Value) = "Total Count of" Then Cells(rt, 1).Value = "Overall Score" Else Cells(rt, 1).Formula = Cells(r, 1).Value End If Cells(rt + 1, 2).Formula = "UCL 99%" Cells(rt + 2, 2).Formula = "UCL 95%" Cells(rt + 3, 2).Formula = strControlItem & " Mean" Cells(rt + 4, 2).Formula = "Site Mean" Cells(rt + 5, 2).Formula = "LCL 95%" Cells(rt + 6, 2).Formula = "LCL 99%" Cells(rt + 7, 2).Formula = "Count" strPageName = Cells(r, 1).Value For c = 3 To cmax + 2 'Must be greater than 2 surveys If Cells(r, c).Value >= 2 Then Cells(rt, ct).Value = Cells(2, c).Value Else End If If Cells(r, c).Value < 2 Then lesscol = lesscol + 1 GoTo Jumper End If If intDataType = 0 Then Cells(rt + 7, ct).FormulaR1C1 = "=R" & r + 1 & "C" & c z95 = "normsinv(.975)*" z99 = "normsinv(.995)*" If Cells(rt + 7, ct).Value > 3 Then Cells(rt + 1, ct).FormulaR1C1 = "=R[" & 3 & "]C[0]+" & z99 & "sqrt(R[" & 2 & "]C[0]*(1-R[" & 2 & "]C[0])/R[" & 6 & "]C[0])" Cells(rt + 2, ct).FormulaR1C1 = "=R[" & 2 & "]C[0]+" & z95 & "sqrt(R[" & 1 & "]C[0]*(1-R[" & 1 & "]C[0])/R[" & 5 & "]C[0])" Cells(rt + 4, ct).FormulaR1C1 = "=R" & r + 1 & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotItems.count + 3 Cells(rt + 5, ct).FormulaR1C1 = "=R[" & -1 & "]C[0]-" & z95 & "sqrt(R[" & -2 & "]C[0]*(1-R[" & -2 & "]C[0])/R[" & 2 & "]C[0])" Cells(rt + 6, ct).FormulaR1C1 = "=R[" & -2 & "]C[0]-" & z99 & "sqrt(R[" & -3 & "]C[0]*(1-R[" & -3 & "]C[0])/R[" & 1 & "]C[0])" End If Cells(rt + 3, ct).FormulaR1C1 = "=R" & r & "C" & c Cells(rt + 4, ct).FormulaR1C1 = "=R" & r & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotItems.count + 3 Else Cells(rt + 7, ct).FormulaR1C1 = "=R" & r & "C" & c sigma = "(R" & r + 2 & "C" & c & ")" If Cells(rt + 7, ct).Value > 4 Then Cells(rt + 1, ct).FormulaR1C1 = "=R[3]C[0]+ tinv(.01,R[6]C[0])*" & sigma & "/sqrt(R[6]C[0])" Cells(rt + 2, ct).FormulaR1C1 = "=R[2]C[0]+ tinv(.05,R[5]C[0])*" & sigma & "/sqrt(R[5]C[0])" Cells(rt + 4, ct).FormulaR1C1 = "=R" & r & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotItems.count + 3 Cells(rt + 5, ct).FormulaR1C1 = "=R[-1]C[0]- tinv(.05,R[2]C[0])*" & sigma & "/sqrt(R[2]C[0])" Cells(rt + 6, ct).FormulaR1C1 = "=R[-2]C[0]- tinv(.01,R[1]C[0])*" & sigma & "/sqrt(R[1]C[0])" End If Cells(rt + 3, ct).FormulaR1C1 = "=R" & r + 1 & "C" & c Cells(rt + 4, ct).FormulaR1C1 = "=R" & r + 1 & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotItems.count + 3 End If Jumper: ct = ct + 1 Next c low = Application.WorksheetFunction.Min(Range(Cells(rt + 6, ct - 1), Cells(rt + 1, 3))) low = Application.WorksheetFunction.RoundDown(low + 0, 0) high = Application.WorksheetFunction.Max(Range(Cells(rt + 6, ct - 1), Cells(rt + 1, 3))) high = Application.WorksheetFunction.RoundUp(high + 0, 0) ActiveSheet.Range(Cells(rt + 7, ct - 1), Cells(rt, 3)).Select Selection.Sort Key1:=Cells(rt + 7, 3), Order1:=xlAscending, _ Orientation:=xlLeftToRight Worksheets("Chart Data").Range(Cells(rt, 2), Cells(rt + 6, ct - 1 - lesscol)).Select Charts.Add With ActiveChart .ApplyCustomType ChartType:=xlUserDefined, TypeName:= _ "Control Chart" .Location xlLocationAsNewSheet, i & "." & Left(strPageName, 7) .Move after:=Charts(Charts.count) .HasTitle = True If intControlItem = 1 Then .ChartTitle.Characters.Text = strControlTitle & Chr(13) & StrConv(strPageName, vbProperCase) & Chr(13) & strControlTime & Chr(13) & LCase$("N >= 2") Else .ChartTitle.Characters.Text = strControlTitle & Chr(13) & StrConv(strPageName, vbProperCase) & Chr(13) & strControlTime & Chr(13) & LCase$("N >= 2") End If .SeriesCollection(3).DataLabels.Font.Background = xlTransparent If intDataType = 0 Then _ .SeriesCollection(3).DataLabels.NumberFormat = "0.0%" With .Axes(xlCategory) .HasTitle = False .MajorTickMark = xlTickMarkOutside .TickLabelPosition = xlTickLabelPositionLow .TickLabels.Orientation = 90 End With With .Axes(xlValue) .HasTitle = True .AxisTitle.Characters.Text = strControlUnit If intDataType = 0 Then .MinimumScaleIsAuto = True .MaximumScaleIsAuto = True .TickLabels.NumberFormat = "0.0%" Else .MinimumScale = low .MaximumScale = high End If End With End With rt = rt + 9 r = r + intDataType + 2 lesscol = 0 Next i End Sub Tag: Codeaholic's StandardLibrary.vbs Tag: 194710
  - 25
    - Interactive images?? I am developing a web page with the following capability needed: I need for the user to be able to post a "dot" or predetermined gif image on top of another image. I then need to store this information on the server so that if another user logs on, he/she will be able to see the dot the previous user posted...and at the same location. Is this possible? Any and all help would be greatly appreciated! Tag: Codeaholic's StandardLibrary.vbs Tag: 194706

Someone asked for my StandardLibrary.vbs file. After some weeks in
close combat with the "black dog" (an animal I'm sure some of you are,
unfortunately, familiar with) I have finally struggled out of the pit
long enough to get in posted:
<http://codeaholic.blogspot.com/2006/08/vbscript-standard-library.html>

Kind regards,
Bruce.

Top