Advertisement

08.15.2008 at 08:43AM PDT, ID: 23651624
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.2

Excel cell borders manipulation in Visual Basic Script

Asked by Hubasan in Microsoft Excel Spreadsheet Software, VB Script

Tags: , , ,

Good day Experts,

I have developed a VB script (Code Snippet below) that can gather information about all Installed MSI's from the remote or local PC (XP SP2) and display it in formatted Excel spreadsheet. However one thing that I was not able to do is set borders in a selection of first raw cells. We are using Excel 2003 in our company and I was looking for cell border constants for this version of Excel but no matter what I found just didn't work. I did a macro from within the Excel and got this:

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

However when I try to implement it with my own selection of A1:K1, it just doesn't work.

Script is fully functional without it, of course, but that's the last thing I wanted to do and just couldn't figure out how.

Any help on this matter would be greatly appreciated and also feel free to use the script for your own needs if you wish.

Thanks guys.Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:

'====================================================================================================
'= Script Name:		GetInstalledSoftware.vbs
'= Author:			Denis Hubanic
'= Created on:			2008-04-23
'= Last Modified:		2008-08-15
'= By:				Denis Hubanic
'= Version:			1.1
'= Description:			Script connects to remote PC and gathers a list of all installed MSI's
'= Notes:			Results are displayed in formated Excel spreadsheet.
'====================================================================================================
 
On Error Resume Next
 
Dim oExcel,oWorkBooks,oWorksheet,oRange
 
Const cPWTitlebar = "Get Installed Software"
 
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oNet = CreateObject("wscript.network")
Set oWS = CreateObject("wscript.shell")
sFolder = oFS.GetSpecialFolder(2)
 
sLocCompName = oNet.ComputerName
 
sComputer = WScript.Arguments(0)
 
If sComputer = "" Then
	Do
	  sComputer = InputBox("Please enter Computer Name of the computer you wish to connect to?", cPWTitlebar,sLocCompName)
	  	If Len(sComputer) = 0 Then
	    	sRes = oWS.Popup ("Sorry, you must enter Computer Name to continue.  Do you wish to try again?", , cPWTitlebar, vbExclamation+vbYesNo)
	      	If sRes = vbNo Then
	        	WScript.Quit
	        End If
	    End If
	Loop Until Len(sComputer) <> 0
End If
 
sFilePath = sFolder & "\Software On-" & sComputer & ".xls"
 
Set oFile = oFS.CreateTextFile(sFilePath, True)
 
Set oWS = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
Set colSoftware = oWS.ExecQuery _
    ("Select * from Win32_Product")
 
oFile.WriteLine "Name" & vbtab & _
    "Version" & vbtab & "Install Date" & vbtab & _
    "Product Code" & vbtab & "Install Location" & vbtab & _
    "Package Cache" & vbtab & "Caption" & vbtab & _ 
    "Install State" & vbtab & "SKU Number" & vbtab & "Vendor" & vbtab _
        &  "Description"
 
For Each oSoftware in colSoftware
	sDate = oSoftware.InstallDate2
	If IsNull(sDate) Then
		sDate = "No Install Date"
	Else
		sDate = CDateWMI(sDate)
	End If
  oFile.WriteLine oSoftware.Name & vbtab & _
  oSoftware.Version & vbtab & _
  sDate & vbtab & _
  oSoftware.IdentifyingNumber & vbtab & _
  oSoftware.InstallLocation & vbtab & _
  oSoftware.PackageCache & vbtab & _
  oSoftware.Caption & vbtab & _
  oSoftware.InstallState & vbtab & _
  oSoftware.SKUNumber & vbtab & _
  oSoftware.Vendor & vbtab & _
  oSoftware.Description
Next
oFile.Close
 
'Open the file in Excel and display results
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
Set oWorkBooks = oExcel.Workbooks.Open(sFilePath,,,,,,,,tab)
Set oWorksheet = oWorkBooks.Worksheets(1)
 
 
'Autofit entire worksheet range
Set oRange = oExcel.Range("A1:K1")
oRange.Font.Bold = True
oRange.Font.Background
Set oRange = oWorksheet.UsedRange
oRange.EntireColumn.Autofit()
 
 
'Sort data,include header row, and Align left
Set oRange2 = oExcel.Range("A1")
Set oRange = oWorksheet.UsedRange
oRange.Sort oRange2, , , , , , , xlYes
oRange.HorizontalAlignment = 2
 
'Horizontal Center allign first row (Left = 2,Center = 3, Right = 4)
Set oFirstRow = oExcel.Range("A1:K1")
With oFirstRow
	.HorizontalAlignment = 3
End With
 
'Shade selection with Gray color
With oFirstRow.Interior
	.ColorIndex = 15
End With
 
 
'Freeze panes on second row
Set oSecondRow = oExcel.Range("2:2").Select
oExcel.ActiveWindow.FreezePanes = True
 
Set oFirstCell = oExcel.Range("A1").Select
 
 
'========================================================================
'=============== FUNCTIONS ==============================================
'========================================================================
 
'Date Function by DH
Function CDateWMI(cim_DateTime)
	Dim sDateTime, iYear, iMonth, iDay
	
	sDateTime = CStr(cim_DateTime)
	
	iYear = CInt(Mid(sDateTime, 1, 4))
	iMonth = CInt(Mid(sDateTime, 5, 2))
	iDay = CInt(Mid(sDateTime, 7, 2))
	
	CDateWMI = CDate(Join(Array(iYear, iMonth, iDay), "/"))
End Function
 
'Time Function by DH
Function CTimeWMI(cim_DateTime)
	Dim sDateTime, iHours, iMinutes, iSeconds
	
	sDateTime = CStr(cim_DateTime)
	
	iHours = CInt(Mid(sDateTime, 9, 2))
	iMinutes= CInt(Mid(sDateTime, 11, 2))
	iSeconds = CInt(Mid(sDateTime, 13, 2))
	
	CTimeWMI = TimeSerial(iHours, iMinutes, iSeconds)
End Function
 
 
'Date-Time conversion UTC to Standard by DH
Function UTCtoStandard(CreationDate)
 UTCtoStandard = CDate(Mid(CreationDate, 5, 2) & "/" & _
 Mid(CreationDate, 7, 2) & "/" & Left(CreationDate, 4) _
 & " " & Mid (CreationDate, 9, 2) & ":" & _
 Mid(CreationDate, 11, 2) & ":" & Mid(CreationDate, _
 13, 2))
End Function
[+][-]08.15.2008 at 09:24AM PDT, ID: 22239534

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: Microsoft Excel Spreadsheet Software, VB Script
Tags: Microsoft, Excel, 2003, Visual Basic Script
Sign Up Now!
Solution Provided By: purplepomegranite
Participating Experts: 1
Solution Grade: A
 
 
[+][-]08.15.2008 at 09:49AM PDT, ID: 22239758

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
 
Loading Advertisement...
20080716-EE-VQP-32 / EE_QW_2_20070628