Save query output as .csv, .xls

I am looking to save a bunch of query paramenters into a csv
file. i am currently playing around with cffile, cfcontent,
cfheader, but i dotn know what the best approach is. Ultimately i
want save dialog to pop up and allow the user to save it to the
desired location with desired name. what is the best way to do this
in cold fusion?
Thanks
Drew

Use cfheader and cfcontent to get the pop up. Use table tags
to format your data.

Similar Messages

Query Output to CSV file

Hi,
I am trying to export a Query result to CSV in comma-delimited tab format.
In SBO it is allowing to save the query results as CSV file; but when I opened
it is in 'Text Unicode' filetype.
Is there anyway save it directly as CSV in comma-delimited tab format.
Thanks Regards
Shiva

Hi Gordon,
Sorry could not reply soon.
Its a smiple query
"SELECT ItemCode, ItemName, ItmsGrpNam,
LeadTime, VATLiable, CardCode"
The things is we might make some changes to it based on customer requirement. But the fact is no matter what query, I have no problem with query. It is while saving it is making a 'tab-delimited' file rather than 'comma-delimited file'. User has to manually open it and save it as CSV file.
Regards
Shiva

Save query output in file

Hi,
I want to save the output of a query in a text file. I have the code to save text in a file using util_file package but i dont know how to use the same code for my query May be if i use cursors it will help but i m not getting the logic. my query is like
SELECT ACCN_PERIOD_COD_VC,SUM (op_amt_faa_nb)
FROM table1
WHERE ACCN_PERIOD_COD_VC like '%-06'
GROUP BY ACCN_PERIOD_COD_VC
any suggestion.. thnks
Ashish

Hi,
From SQL:
SQL>SPOOL abc.txt
SQL>SELECT ACCN_PERIOD_COD_VC,SUM (op_amt_faa_nb)
FROM table1
WHERE ACCN_PERIOD_COD_VC like '%-06'
GROUP BY ACCN_PERIOD_COD_VC;
SQL>SPOOL OFF;
From PL/SQL: You will have to write cursor.
Open the Cursor.
LOOP
Fetch the record
Write into file using UTL_FILE
END LOOP
Close Cursor
Regrads

Procedure to save the output of a query into excel file or flat file

Procedure to save the output of a query into excel file or flat file
I want to store the output of my query into a file and then export it from sql server management studio to a desired location using stored procedure.
I have run the query --
DECLARE @cmd VARCHAR(255)
SET @cmd = 'bcp "select * from dbo.test1" queryout "D:\testing2.xlsx;" -U "user-PC\user" -P "" -c '
Exec xp_cmdshell @cmd
error message--
SQLState = 28000, NativeError = 18456
Error = [Microsoft][SQL Server Native Client 10.0][SQL Server]Login failed for user 'user-PC\user'.
NULL
Goel.Aman

Hello,
-T:
Specifies that the bcp utility connects to SQL Server with a trusted connection using integrated security. The security credentials of the network user,
login_id, and password are not required. If
–T is not specified, you need to specify
–U and –P to successfully log in.
-U:
Specifies the login ID used to connect to SQL Server.
Note: When the bcp utility is connecting to SQL Server with a trusted connection using integrated security, use the
-T option (trusted connection) instead of the
user name and password combination
I would suggest you take a look at the following article:
bcp Utility: http://technet.microsoft.com/en-us/library/ms162802.aspx
A similar thread regarding this issue:
http://social.msdn.microsoft.com/Forums/sqlserver/en-US/b450937f-0ef5-427a-ae3b-115335c0d83c/bcp-connection-error-sqlstate-28000-nativeerror-18456?forum=sqldataaccess
Regards,
Elvis Long
TechNet Community Support

Sap query output to save on application server

Hi All,
I have one requirement, want to save the output of sap query on application server as a text file?
Is there any work around?
Regards
Vasumathi
Edited by: komma vasumathi on Nov 5, 2009 10:32 AM

Hi Vasumathi,
Application server path cannot be accessed unless otherwise using OPEN DATASET. More over, Infoset cannot be executed directly. It can be accessed through SAP Query only.
Writing Logic for 2 or 3 tables with Inner Join will not be a big deal. Writing Abap program will be optimum for you FTP requirement.
1. create a folder in AL11 as \sap\common\
2. create z program and Declare sel-screen parameters : selopt1, selopt2
3. Query : Select Afield1 Afield2 Bfield1 Bfield2 from table1 as A inner join table2 as B on Afield1 eq Bfield1 where Afield1 in selopt1 and Afield2 in selopt2 into corresponding fields of table itab.
4. creating file at application sever
      w_fileloc = '\sap\common\file.txt'
     OPEN DATASET w_fileloc FOR OUTPUT IN TEXT MODE ENCODING DEFAULT.
    . Loop itab into wa_itab.
      Transfer wa_itab to w_fileloc.
     clear w_fileloc.
    endloop.
5. goto AL11 and check the file file.txt in folder \sap\common
Please let me know if you need more information or close this thread by offiering the points( If you are satisfied).
Regards,
Sakthivel N

Save query in CSV?

hi,
i want save query in CSV, i have seen option, i am able save in CSV, i dont want any other information all details when i save in CSV , , i dont want dellete manually information, when i save i need only data like infospoke or openhub?
is it possible?
regards
ss

Hello Suneel,
Your question is a bit unclear. It might help if you rephrase it.
In any case, you can use transaction RSCRM_BAPI to run a BeX query and then save the results to a file.
If you use an InfoSpoke (or open hub destination in 7.0), the contents of target CSV file will be overwritten each time you run the InfoSpoke (or the DTP in 7.0).
Hope this helps.

How to save current output page as pdf or xls format?

hello expert,
i have make 2D line graph . now i am trying to save current output page as pdf or xls format.
how can i do this?
please reply soon
thanks in advance

I have a similar problem with Firefox on android. When saving a page as PDF, often the PDF page size isn't big enough and just shows part of the full web page. Is there any way to set the PDF page size and make it bigger,say A4 or some other size?

Harvesting asset info and output to CSV

I need a script modified that will run on all servers in a work group in order to gather asset data on the appliances running Windows Server 2000 embedded edition. There are no domain services and these systems and this network technology is not an option
in our environment due to proprietary security, networking and infrastructure restrictions. I have found a script that works but i need it modified to output to a csv as it wont output and .xls .xlsx properly. The script will be run on the only computer on
the network that can access these devices. Any help on this would be awesome.
' Get Windows Server Information
' Written By Kely Mulcahey, E.C.S. LLC.
' Created: March 1, 2006
' Version: 3.0, Revised 5/30/2014
On Error Resume Next
Dim PUBOSVer ' Global OS Version
' Open File For Writing
Set WshNetwork = WScript.CreateObject("WScript.Network")
Const ForReading = 1
' Get Server List
strServerFilename = "servers.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strServerFilename) Then
' Open Servers File
Set objServers = objFSO.OpenTextFile(strServerFilename, ForReading)
Else
' Server File is missing: Exit
intMsg = MsgBox("File: " & Chr(34) & UCASE(strServerFilename) & Chr(34) & _
" is either " & _
"Missing or Damaged!" & vbcrlf & _
vbcrlf & _
"This Script will now Exit.", vbCritical, "Server File Error")
WScript.Quit(0)
End If
Do Until objServers.AtEndOfStream
strNewServer = Trim(objServers.ReadLine)
strServerList = strServerList & strNewServer & vbcrlf
intServerCnt = intServerCnt + 1
Loop
' Enumerate Server Array
For a = 0 To intServerCnt - 1
strServer = Split(strServerList, vbcrlf)
Next
' Create Excel Spreadsheet
Set objXLA = CreateObject("Excel.Application")
objXLA.Visible = False
objXLA.DisplayAlerts = False
Set objWorkbook = objXLA.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)
'Excel Constants
Const xlEdgeLeft = 7
Const xlContinuous = 1
Const xlNone = -4142
Const xlMedium = -4138
Const xlThin = 2
'Set Headers
' System Information
objXLA.Cells(1,1).Value = "Service ID"
objXLA.Cells(1,2).Value = "Company Name"
objXLA.Cells(1,3).Value = "Manufacturer"
objXLA.Cells(1,4).Value = "Model"
objXLA.Cells(1,5).Value = "Operating System"
' Processors
objXLA.Cells(1,6).Value = "Processor Type"
objXLA.Cells(1,7).Value = "Processors"
' RAM
objXLA.Cells(1,8).Value = "RAM"
objXLA.Cells(1,9).Value = "Slots"
objXLA.Cells(1,10).Value = "Max Capacity"
' Network
objXLA.Cells(1,11).Value = "NIC Port"
objXLA.Cells(1,12).Value = "Speed"
objXLA.Cells(1,13).Value = "Connection Name"
objXLA.Cells(1,14).Value = "Primary IP"
objXLA.Cells(1,15).Value = "Virtual IP"
objXLA.Cells(1,16).Value = "Primary DNS"
objXLA.Cells(1,17).Value = "Secondary DNS"
' Hard Disks
objXLA.Cells(1,18).Value = "Interface"
objXLA.Cells(1,19).Value = "Physical Disks"
objXLA.Cells(1,20).Value = "Disk Size"
objXLA.Cells(1,21).Value = "Fault Tolerant"
objXLA.Cells(1,22).Value = "Hot Spare"
' Set Top Line
objXLA.Cells(1, 1).EntireRow.Font.Bold = True
objXLA.Cells(1, 1).EntireRow.Font.Underline = True
For b = 0 To UBound(strServer) - 1
strServerParts = Split(strServer(b), " ")
strComputer = strServerParts(0)
' Parse Server Information
If UBound(strServerParts) = 2 Then
strUsername = Trim(strServerParts(1))
strPassword = Trim(strServerParts(2))
End If
' Create Connection Object
Set objWMIService = Nothing
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objSWbemLocator.ConnectServer _
(strComputer, "root\cimv2", strUsername, strPassword)
objWMIServices.Security_.ImpersonationLevel = 3
' Check if Server Exists
For intWMICheck = 0 To 15
If Not objWMIService Is Nothing Then
Exit For
Else
WScript.Sleep(1000)
End If
Next
' Server Exists
If intWMICheck < 15 Then
' Get CPU Information
Set colProcessor = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
For Each colProc In colProcessor
strManuf = colProc.Manufacturer
strDescription = ProcessorName(colProc.Name)
strClockSpeed = colProc.CurrentClockSpeed
strSocket = strSocket & colProc.SocketDesignation & vbcrlf
strProcID = strProcID & colProc.ProcessorID & vbcrlf
strUniqueID = strUniqueID & colProc.UniqueID & vbcrlf
ProcCount = ProcCount + 1
Next
' Determine if Hyperthreading is Enabled
strHTStatus = GetHTStatus(strSocket, ProcCount, strProcID, strUniqueID)
' DC / HT Results
If strHTStatus = "True" Then
If InStr(strManuf, "Intel") Then
strDescription = strDescription & " (Dual Core or H/T)"
Else
strDescription = strDescription & " (Dual Core)"
End If
ProcCount = ProcCount / 2
End If
' Export Information
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colCS = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
' Write Basic System Information
For Each objItem in colCS
Set colOS = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each objItemOS in colOS
' Get SP Version
If objItemOS.CSDVersion <> "" Then
strSPVersion = objItemOS.CSDVersion
Else
strSPVersion = "No Service Packs Installed"
End If
If objItemOS.LastBootUpTime <> "" Then
strLastBoot = DateConvert(objItemOS.LastBootUpTime)
Else
strLastBoot = "N/A"
End If
' Set OS Version Information
PUBOSVer = objItemOS.Caption
objXLA.Cells(b + 2, 1).Value = objItemOS.csname
objXLA.Cells(b + 2, 3).Value = objItem.Manufacturer
objXLA.Cells(b + 2, 4).Value = objItem.Model
objXLA.Cells(b + 2, 5).Value = PUBOSVer & " - " & strSPVersion
objXLA.Cells(b + 2, 6).Value = strDescription
objXLA.Cells(b + 2, 7).Value = ProcCount
objXLA.Cells(b + 2, 8).Value = MemoryConvert(objItem.TotalPhysicalMemory)
Next
Next
' Get Memory Breakdown
Dim strMemBreak
strMemBreak = Split(MemoryBreakdown(), vbcrlf)
n = 0
For n = 0 To UBound(strMemBreak) - 1
strSlots = strSlots & strMemBreak(n) & Chr(10)
Next
strMaxCapacity = strMemBreak(UBound(strMemBreak))
objXLA.Cells(b + 2, 9).Value = Left(strSlots, Len(strSlots) - 1)
objXLA.Cells(b + 2, 10).Value = strMaxCapacity
' Dispose
strMemBreak = ""
strMaxCapacity = ""
strSlots = ""
'--------------Computer Information (End)------------------'
'-------------Partition Information (Start)----------------'
' Get Drive Count
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set DiskItemsParent = objWMIService.ExecQuery("Select * from Win32_DiskDrive")
intCount = DiskItemsParent.Count
' Process Drives
intDriveMark = 0
For i = 0 To intCount - 1
Set DiskItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE Index = " & i)
For Each diskItem in DiskItems
' Convert Drive Size
If diskItem.Size <> "" Then strSize = strSize & ByteConvert(diskItem.Size) & Chr(10) Else strSize = "N/A" & Chr(10)
If diskItem.StatusInfo <> "" Then strStsInfo = diskItem.StatusInfo Else strStsInfo = "N/A"
If diskItem.SCSIBus <> "" Then strSCSIBus = diskItem.SCSIBus Else strSCSIBus = "N/A"
If diskItem.SCSILogicalUnit <> "" Then strSCSILog = diskItem.SCSILogicalUnit Else strSCSILog = "N/A"
If diskItem.SCSIPort <> "" Then strSCSIPort = diskItem.SCSIPort Else strSCSIPort = "N/A"
If diskItem.SCSITargetId <> "" Then strSCSITarget = diskItem.SCSITargetId Else strSCSITarget = "N/A"
' Get Model
strModel = Split(diskItem.Model, " ")
' Detect HP Array
If (UCase(strModel(0)) = "HP" Or UCase(strModel(0)) = "COMPAQ") And intDriveMark = 0 Then
strGetHPArray = GetHPArray(strComputer, strUsername, strPassword)
If strGetHPArray <> "" Then
strSplitHP = Split(strGetHPArray, Chr(13))
For a = 0 To UBound(strSplitHP)
strSplitResult = Split(strSplitHP(a), ":")
i = i + 1
strDriveCount = strDriveCount & Trim(strSplitResult(0)) & Chr(10)
strDriveSize = strDriveSize & Trim(strSplitResult(1)) & Chr(10)
strDriveFault = strDriveFault & Trim(strSplitResult(2)) & Chr(10)
strDriveSpare = strDriveSpare & Trim(strSplitResult(3)) & Chr(10)
strInterface = strInterface & "HP SCSI" & Chr(10)
Next
' Set Controller Output
objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
intDriveMark = 1 ' Mark That Data was Obtained
Else
strDriveCount = strDriveCount & "1" & Chr(10)
strDriveSize = strDriveSize & strSize & Chr(10)
strDriveFault = strDriveFault & "N/A" & Chr(10)
strDriveSpare = strDriveSpare & "N/A" & Chr(10)
strInterface = strInterface & "HP SCSI " & Chr(10)
' Set Controller Output
intDriveMark = 1 ' Mark That Another Pass is Invalid
' Set Controller Output
objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
End If
Else
strDriveCount = strDriveCount & "1" & Chr(10)
strDriveSize = strDriveSize & strSize & Chr(10)
strDriveFault = strDriveFault & "N/A" & Chr(10)
strDriveSpare = strDriveSpare & "N/A" & Chr(10)
' Set Controller Output
intDriveMark = 1 ' Mark That Another Pass is Invalid
' Set Controller Output
objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
' Set Interface
If diskItem.InterfaceType = "IDE" Then
strInterface = strInterface & "ATA" & Chr(10)
Else
strInterface = strInterface & "SATA/SCSI" & Chr(10)
End If
End If
' Set Cell Value "Interface"
objXLA.Cells(b + 2, 18).Value = Left(strInterface, Len(strInterface) - 1)
Next
' Dispose Drive Sizes
strDriveSize = ""
Next
' Dispose Drive Values
strDriveCount = ""
strDriveFault = ""
strDriveSpare = ""
strInterface = ""
'----Partition Information (End)---------------------------'
'----Network Information (Start)---------------------------'
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter")
i = 1
eth = 0
Dim STOREDIP(0)
intNum = 0
For Each objItem in colItems
If objItem.NetConnectionStatus <> "" Then
' Determine Connection Status
If objItem.NetConnectionStatus = 0 Then
strNetStat = "Disabled"
ElseIf objItem.NetConnectionStatus = 2 Then
strNetStat = "Connected"
ElseIf objItem.NetConnectionStatus = 7 Then
strNetStat = "Disconnected"
Else
strNetStat = "Unknown"
End If
If objItem.NetConnectionStatus <> 0 Then
' Get Network Card Information
Const HKEY_LOCAL_MACHINE = &H80000002
strKeyPath1 = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
strKeyPath2 = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters"
strHostEntry = "Hostname"
strDomainEntry = "Domain"
strNodeEntry = "DhcpNodeType"
strRoutingEntry = "IPEnableRouter"
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strHostEntry,strHostname
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strDomainEntry,strDomain
objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath2,strNodeEntry,dwNodeType
objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath1,strRoutingEntry,dwIPRouting
Select Case dwNodeType
Case 4 strNodeType = "Mixed"
Case 8 strNodeType = "Hybrid"
Case Else strNodeType = dwNodeType
End Select
If dwIPRouting = 0 Then
strIPRouting = "No"
ElseIf dwIPRouting = 1 Then
strIPRouting = "Yes"
Else
strIPRouting = "?"
End If
Set colFirstNicConfig = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objFirstNicConfig In colFirstNicConfig
strDnsWins = objFirstNicConfig.DNSEnabledForWINSResolution
Next
Set colNicConfigs = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
' Display per-adapter settings.
For Each objNicConfig In colNicConfigs
intIndex = objNicConfig.Index
Set objNic = objWMIService.Get("Win32_NetworkAdapter.DeviceID=" & intIndex)
' Connection Name
If GetOsVer > 5 Then
' Works only in XP / 2003
strNetConn = objNic.NetConnectionID
ElseIf GetOsVer = 5 Then
strNetConn = ""
' Get Home Drive of Remote Server
Set objShell = CreateObject("WScript.Shell")
Set objEtherName = objShell.Exec("cmd /c ipconfig | find " & Chr(34) & "Ethernet" & Chr(34))
strEtherName = objEtherName.StdOut.ReadAll()
strEtherParse = Split(strEtherName, Chr(13))
strEtherConn = Split(strEtherParse(eth), " ")
For y = 2 To UBound(strEtherConn)
strNetConn = strNetConn & " " & strEtherConn(y)
Next
' Trim Connection Name
strNetConn = Left(Trim(strNetConn), Len(Trim(strNetConn)) - 1)
Else
strNetConn = ""
End If
' IP Addresses
strIPAddresses = ""
If Not IsNull(objNicConfig.IPAddress) Then
For Each strIPAddress In objNicConfig.IPAddress
strIPAddresses = strIPAddresses & strIPAddress & " "
Next
End If
strIPCollection = Split(strIPAddresses, " ")
' Subnets
strIPSubnets = ""
If Not IsNull(objNicConfig.IPSubnet) Then
For Each strIPSubnet In objNicConfig.IPSubnet
strIPSubnets = strIPSubnets & strIPSubnet & " "
Next
End If
strSMCollection = Split(strIPSubnets, " ")
' Virtual IP's
strVirtual = ""
If UBound(strIPCollection) > 1 Then
For IPCount = 1 To UBound(strIPCollection) - 1
strVirtual = strVirtual & (strIPCollection(IPCount) & " / " & strSMCollection(IPCount)) & Chr(10)
Next
strVirtual = Left(strVirtual, Len(strVirtual) - 1)
End If
If Trim(strVirtual) = "" Then strVirtual = "N/A"
' Gateways
strDefaultIPGateways = ""
If Not IsNull(objNicConfig.DefaultIPGateway) Then
For Each strDefaultIPGateway In objNicConfig.DefaultIPGateway
strDefaultIPGateways = strDefaultIPGateways & strDefaultIPGateway & " "
Next
Else
strDefaultIPGateways = "N/A"
End If
' If IP is repeated, and was already reported.
intSkipLoop = 0
If Trim(strNetConn) <> "" Then
For j = 0 To intNum - 1
If STOREDIP(j) = strIPAddresses Then
intSkipLoop = 1
Exit For
End If
Next
If intSkipLoop = 0 Then
ReDim Preserve STOREDIP(intNum)
STOREDIP(intNum) = strIPAddresses
intNum = intNum + 1
End If
Else
intSkipLoop = 1
End If
' DNS
strDNSServerSearchOrder = ""
If Not IsNull(objNicConfig.DNSServerSearchOrder) Then
For Each strDNSServer In objNicConfig.DNSServerSearchOrder
strDNSServerSearchOrder = strDNSServerSearchOrder & strDNSServer & " "
Next
strDNS = Split(strDNSServerSearchOrder, " ")
strDNS1 = strDNS(0)
If Trim(strDNS1) = "" Then strDNS1 = "N/A"
If UBound(strDNS) > 1 Then
strDNS2 = strDNS(1)
Else
strDNS2 = "N/A"
End If
Else
strDNS1 = "N/A"
strDNS2 = "N/A"
End If
' Run Output Process
If intSkipLoop = 0 Then
' Connection Speed
strSpeed = "Unknown"
Set objWMIService2 = objSWbemLocator.ConnectServer _
(strComputer, "root\WMI", strUsername, strPassword)
objWMIServices.Security_.ImpersonationLevel = 3
Set listAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_LinkSpeed")
Set enumAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_EnumerateAdapter")
For Each objAdapter in listAdapters
For Each objEnum in enumAdapters
intEnum = Len(objEnum.DeviceName)
If objNicConfig.SettingID = Right(objEnum.DeviceName, intEnum - 8) Then
If objEnum.InstanceName = objAdapter.InstanceName Then
intLength = Len(objAdapter.NdisLinkSpeed/10000)
If intLength > 3 Then
strSpeed = Left(objAdapter.NdisLinkSpeed/10000, intLength - 3)
strSpeed = strSpeed & ".0 Gbps"
Else
strSpeed = objAdapter.NdisLinkSpeed/10000 & " Mbps"
End If
End If
End If
Next
Next
strTotalDesc = strTotalDesc & objNicConfig.Description & Chr(10)
strTotalSpeed = strTotalSpeed & strSpeed & Chr(10)
strTotalNetConn = strTotalNetConn & strNetConn & Chr(10)
strPrimaryIP = strPrimaryIP & strIPCollection(0) & " / " & strSMCollection(0) & Chr(10)
strDNSTotal1 = strDNSTotal1 & strDNS1 & Chr(10)
strDNSTotal2 = strDNSTotal2 & strDNS2 & Chr(10)
strTotalVirtual = strTotalVirtual & strVirtual & Chr(10)
i = i + 1
eth = eth + 2
' Dispose
strDescription = ""
ProcCount = 0
strClockSpeed = ""
strInterface = ""
intCount = 0
strSize = ""
strSpeed = ""
strIPCollection = ""
strVirtual = ""
strDNS = ""
strDNS1 = ""
strDNS2 = ""
End If
Next
' Output
' Trim Leading Chr(10)
If Left(strPrimaryIP, 1) = Chr(10) Then strPrimaryIP = Right(strPrimaryIP, Len(strPrimaryIP) - 1)
If Left(strTotalVirtual, 1) = Chr(10) Then strTotalVirtual = Right(strTotalVirtual, Len(strTotalVirtual) - 1)
If Left(strDNSTotal1, 1) = Chr(10) Then strDNSTotal1 = Right(strDNSTotal1, Len(strDNSTotal1) - 1)
If Left(strDNSTotal2, 1) = Chr(10) Then strDNSTotal2 = Right(strDNSTotal2, Len(strDNSTotal2) - 1)
objXLA.Cells(b + 2, 11).Value = Trim(Left(strTotalDesc, Len(strTotalDesc) - 1))
objXLA.Cells(b + 2, 12).Value = Trim(Left(strTotalSpeed, Len(strTotalSpeed) - 1))
objXLA.Cells(b + 2, 13).Value = Trim(Left(strTotalNetConn, Len(strTotalNetConn) - 1))
objXLA.Cells(b + 2, 14).Value = Trim(Left(strPrimaryIP, Len(strPrimaryIP) - 1))
objXLA.Cells(b + 2, 15).Value = Trim(Left(strTotalVirtual, Len(strTotalVirtual) - 1))
objXLA.Cells(b + 2, 16).Value = Trim(Left(strDNSTotal1, Len(strDNSTotal1) - 1))
objXLA.Cells(b + 2, 17).Value = Trim(Left(strDNSTotal2, Len(strDNSTotal2) - 1))
End If
End If
' Dispose Per Loop
strTotalDesc = ""
strTotalSpeed = ""
strTotalNetConn = ""
strPrimaryIP = ""
strDNSTotal1 = ""
strDNSTotal2 = ""
strTotalVirtual = ""
Set eth = 0
Set i = 0
Next
'------------Network Information (End)------------------'
Else
'No Data Present
objXLA.Cells(b + 2, 1).Value = strComputer
objXLA.Cells(b + 2, 3).Value = "Information Not Available"
objXLA.Cells(b + 2, 1).EntireRow.Font.Bold = True
objXLA.Cells(b + 2, 1).EntireRow.Interior.ColorIndex = 44
End If
' Dispose Per Server
ProcCount = 0
strSocket = ""
strProcID = ""
strUniqueID = ""
Set objWMIService = Nothing
Next
'-----------------Functions (Start)---------------------'
' System Memory Conversion
Function MemoryConvert(strMem)
Dim intLength
Dim intExp
Dim intSize
Dim strSize
Dim strMeasure
Dim strMemory
intLength = Len(strMem)
If (intLength Mod 4 = 0) Then
intExp = CInt((intLength / 3) - 2)
Else
intExp = CInt((intLength / 3) - 1)
End If
' Convert to Lowest Integer Value
For intCount = 1 To Len(intExp)
chrRead = Mid(intExp, intCount, 1)
If chrRead = "." Then
Exit For
Else
strRead = strRead & chrRead
End If
Next
intExp = Cint(strRead)
intSize = CLng(strMem / (2 ^ (intExp * (10))))
If Len(intSize) = 1 Then
strFormat = FormatNumber(CStr(intSize), 2)
Else
strFormat = intSize + 1
End If
If (intExp = 1) Then
strMeasure = "KB"
ElseIf (intExp = 2) Then
strMeasure = "MB"
ElseIf (intExp = 3) Then
strMeasure = "GB"
ElseIf (intExp = 4) Then
strMeasure = "TB"
ElseIf (intExp = 5) Then
strMeasure = "PB"
ElseIf (intExp = 6) Then
strMeasure = "EB"
End If
MemoryConvert = strFormat & " " & strMeasure
End Function
' System Byte Conversion
Function ByteConvert(strMem)
Dim intLength
Dim intExp
Dim intSize
Dim strSize
Dim strMeasure
Dim strMemory
intLength = Len(strMem)
If (intLength Mod 3 = 0) Then
intExp = (intLength / 3) - 1
Else
intExp = (intLength / 3)
End If
' Convert to Lowest Integer Value
For intCount = 1 To Len(intExp)
chrRead = Mid(intExp, intCount, 1)
If chrRead = "." Then
Exit For
Else
strRead = strRead & chrRead
End If
Next
intExp = Cint(strRead)
intSize = CLng(strMem / (2 ^ (intExp * (10))))
strFormat = FormatNumber(CStr(intSize), 2)
If (intExp = 1) Then
strMeasure = "KB"
ElseIf (intExp = 2) Then
strMeasure = "MB"
ElseIf (intExp = 3) Then
strMeasure = "GB"
ElseIf (intExp = 4) Then
strMeasure = "TB"
ElseIf (intExp = 5) Then
strMeasure = "PB"
ElseIf (intExp = 6) Then
strMeasure = "EB"
End If
ByteConvert = strFormat & " " & strMeasure
End Function
' System RAID Byte Conversion
Function ByteConvertRAID(strMem)
Dim intLength
Dim intExp
Dim intSize
Dim strSize
Dim strMeasure
Dim strMemory
intLength = Len(strMem)
If (intLength Mod 3 = 0) Then
intExp = (intLength / 3) - 1
Else
intExp = (intLength / 3)
End If
' Convert to Lowest Integer Value
For intCount = 1 To Len(intExp)
chrRead = Mid(intExp, intCount, 1)
If chrRead = "." Then
Exit For
Else
strRead = strRead & chrRead
End If
Next
intExp = Cint(strRead)
intSize = (strMem / (2 ^ (intExp * (10))))
strFormat = FormatNumber(CStr(intSize), 2)
If (intExp = 0) Then
strMeasure = "MB"
ElseIf (intExp = 1) Then
strMeasure = "GB"
ElseIf (intExp = 2) Then
strMeasure = "TB"
ElseIf (intExp = 3) Then
strMeasure = "PB"
ElseIf (intExp = 4) Then
strMeasure = "EB"
End If
ByteConvertRAID = strFormat & " " & strMeasure
End Function
' Trim Processor Description
Function ProcessorName(strName)
Dim intCounter
Dim strRead
Dim chrRead, chrReadMore
For intCounter = 1 to Len(strName)
chrRead = Mid(strName, intCounter, 1)
chrReadMore = Mid(strName, intCounter + 1, 1)
If ((chrRead <> " ") Or ((chrRead = " ") And (chrReadMore <> " "))) Then
strRead = strRead & chrRead
End If
Next
ProcessorName = Trim(strRead)
End Function
' Get Hyper-Threading Status
Function GetHTStatus(strName, intProc, strID, strUnique)
strNameArray = Split(strName, vbcrlf)
strIDArray = Split(strID, vbcrlf)
strUniqueList = Split(strUnique, vbcrlf)
intTotal = 0
' Check Socket Designation
For i = 0 To UBound(strNameArray) - 1
intMark = 1
' Check for Redundancies
For j = i + 1 To UBound(strNameArray) - 1
If strNameArray(i) = strNameArray(j) Then
intMark = 0
End If
Next
' If Redundant Unique ID's Exist
For j = i + 1 To UBound(strNameArray) - 1
If strUniqueList(i) <> "" And strUniqueList(j) <> "" And _
(strUniqueList(i) <> strUniqueList(j)) Then
intMark = 1
End If
Next
' Check for NULL ProcessorID
If Trim(strIDArray(i)) = "0000000000000000" Then
intMark = 0
End If
' Calculate Total
If intMark = 1 Then
intTotal = intTotal + intMark
End If
Next
' Compare Results
If intProc = 2 * intTotal Then
GetHTStatus = "True"
Else
GetHTStatus = "False"
End If
End Function
' Get Memory Breakdown
Function MemoryBreakdown
Set colPMAItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemoryArray",,48)
For Each objPMAItem in colPMAItems
lngMax = CLng(objPMAItem.MaxCapacity)
intCount = CInt(objPMAItem.MemoryDevices)
Next
ReDim Preserve strPMArray(intCount)
Set colPMItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",,48)
For Each objPMItem in colPMItems
strValue = strValue & objPMItem.DeviceLocator & ": "
strValue = strValue & objPMItem.Capacity / 2^20 & "MB, "
strValue = strValue & objPMItem.Speed & "MHz"
strPMArray(TrimTrailingNumber(objPMItem.Tag)) = strValue
strValue = ""
Next
j = 0
strResult = ""
For j = 0 To intCount - 1
If Trim(strPMArray(j)) = "" Then strPMArray(j) = "<Empty>"
strResult = strResult & strPMArray(j) & vbcrlf
Next
strResult = strResult & (lngMax / 2^10) & "MB"
MemoryBreakdown = strResult
End Function
' Get Part Name
Function ExtractPartName(strName)
Dim chrRead
Dim strRead
Dim i
For i = 2 To Len(strName)
chrRead = Mid(strName, Len(strName) - (i - 1), 1)
If chrRead <> Chr(34) Then
strRead = chrRead & strRead
Else
Exit For
End If
Next
ExtractPartName = strRead
End Function
' Get Trailing Number
Function TrimTrailingNumber(strNum)
Dim chrRead
Dim strRead
Dim intLen
strNum = Trim(strNum)
intLen = Len(strNum)
i = 1
For i = 1 To intLen
chrRead = Mid(strNum, intLen - (i - 1), 1)
If IsNumeric(chrRead) = "True" Then
strRead = chrRead & strRead
Else
Exit For
End If
Next
TrimTrailingNumber = strRead
End Function
' Function: WMIDateStringToDate(dtmDate)
Function WMIDateToString(dtmDate)
WMIDateToString = CDate(Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & _
Left(dtmDate, 4) & " " & _
Mid(dtmDate, 9, 2) & ":" & _
Mid(dtmDate, 11, 2) & ":" & _
Mid(dtmDate, 13, 2))
End Function
' Function: GetOsVer
Function GetOsVer
Set colOperatingSystems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOperatingSystem In colOperatingSystems
GetOSVer = CSng(Left(objOperatingSystem.Version, 3))
Next
End Function
' Function: GetHPArray
Function GetHPArray(strComputer2, strUsername2, strPassword2)
' Check for 64-bit Windows
If InStr(PUBOSVer, "x64") Then
strCompaq = "Program Files (x86)\Compaq\Cpqacuxe\Bin"
Else
strCompaq = "Program Files\Compaq\Cpqacuxe\Bin"
End If
' Create Connection Object
Set objWMIServiceRem = objWMIService.Get("Win32_Process")
' Confirm Location of Compaq Array Manager
Set objHPShell = CreateObject("WScript.Shell")
Set objHPFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork2 = WScript.CreateObject("WScript.Network")
WshNetwork2.MapNetworkDrive "", "\\" & strComputer2 & "\C$" ,,strUsername2, strPassword2
strProgram = "\\" & strComputer2 & "\C$\" & strCompaq & "\cpqacuxe.exe"
' Ensure Access is Possible
If objHPFSO.FileExists(strProgram) Then
' Process Array Config
strProcess = Chr(34) & "C:\" & strCompaq & "\cpqacuxe.exe" & Chr(34) & " -c c:\output.txt"
Process = objWMIServiceRem.Create(strProcess, null, null, intProcessID)
' Check for "output.txt"
For intTimerHP = 0 To 10
If objFSO.FileExists("\\" & strComputer2 & "\C$\output.txt") Then
Exit For
Else
WScript.Sleep(1000)
End If
Next
' Process Output
If intTimerHP < 10 Then
' Check for Locked Output File
Set objHPOutputFile = objHPFSO.GetFile("\\" & strComputer2 & "\C$\output.txt")
If objHPOutputFile.Size <> 0 Then
' Close File
Set objHPOutputFile = Nothing
' Continue Processesing File
Set objHPInputFile = objHPFSO.OpenTextFile("\\" & strComputer2 & "\C$\output.txt", ForReading)
Do Until objHPInputFile.AtEndOfStream
strHPArray = strHPArray & objHPInputFile.ReadLine & vbcrlf
Loop
' Close Input File
objHPInputFile.Close
' Close Link to Server
objHPFSO.DeleteFile("\\" & strComputer2 & "\C$\output.txt")
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
' Create String Array
strHPParse = Split(strHPArray, vbcrlf)
' Parse For Individual RAID Arrays
Dim strArrayList()
z = 0
For i = 0 To UBound(strHPParse)
j = 0
' Array and Drives
If InStr(strHPParse(i), "Array Specifications") Then
ReDim Preserve strArrayList(z)
strArrayList(z) = strArrayList(z) & strHPParse(i) & vbcrlf
For j = i + 1 To Ubound(strHPParse)
If InStr(strHPParse(j), "Array Specifications") Then
Exit For
Else
strArrayList(z) = strArrayList(z) & strHPParse(j) & vbcrlf
End If
Next
z = z + 1
End If
Next
' Process Each RAID Array
x = 0
For x = 0 To UBound(strArrayList)
strListParse = Split(strArrayList(x), vbcrlf)
For y = 0 To UBound(strListParse)
' Drives
If Left(strListParse(y), 6) = "Drive=" Then
strDrives = ""
strDrives = Split(strListParse(y), ",")
k = 0
For j = 0 To UBound(strDrives)
k = k + 1
Next
strDriveCount = k ' For Output
End If
' Hot Spare
If InStr(strListParse(y), "OnlineSpare=") Then
If InStr(strListParse(y), "OnlineSpare= No") Then
strHotSpare = strHotSpare & "N" ' For Output
Else
strHotSpare = strHotSpare & "Y" ' For Output
End If
End If
' Logical Drives
If InStr(strListParse(y), "Logical Drive Specifications") Then
' Find First Logical Drive
strRAID = Split(strListParse(y + 2), " ")
strRAIDResult = strRAIDResult & "RAID " & strRAID(1) & " / " ' For Output
strGetDrive = Split(strListParse(y + 3), " ")
strRAIDSize = strRAIDSize & ByteConvertRAID(strGetDrive(1)) & " / " ' For Output
End If
Next
' Process Results
strRAIDSize = Left(strRAIDSize, Len(strRAIDSize) - 3)
strRAIDResult = Left(strRAIDResult, Len(strRAIDResult) - 3)
strNewList = strNewList & strDriveCount & _
":" & strRAIDSize & ":" & strRAIDResult & ":" & strHotSpare & Chr(13)
' Dispose Array Variables
strDriveCount = ""
strRAIDSize = ""
strRAIDResult = ""
strHotSpare = ""
Next
' Return Array Output
GetHPArray = Left(strNewList, Len(strNewList) - 1)
Exit Function
Else ' "output.txt" Is Locked
' Close File
Set objHPOutputFile = Nothing
' Kill Remote Connection
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
GetHPArray = ""
Exit Function
End If
Else ' "output.txt" Does not Exist
' Kill Remote Connection
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
GetHPArray = ""
Exit Function
End If
Else ' "Array Manager Does not Exist
' Input not Available
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
GetHPArray = ""
Exit Function
End If
End Function
'--------------------Functions (End)--------------------'
' Set Excel Attributes
Const xlVAlignTop = -4160
Set objRange2 = objWorksheet.UsedRange
objRange2.VerticalAlignment = xlVAlignTop
' Set Font Attributes
objXLA.Cells.Font.Size = 8
objXLA.Cells.Font.Name = "Arial"
objXLA.Cells.Font.ColorIndex = 11
objXLA.Cells.EntireColumn.AutoFit
objXLA.Cells(1, 9).ColumnWidth = 30 ' RAM Slots
objXLA.Cells(1, 11).ColumnWidth = 40 ' NIC Port
objXLA.Cells(1, 13).ColumnWidth = 25 ' Connection Name
objXLA.Cells(1, 14).ColumnWidth = 25 ' Interface IP's
objXLA.Cells(1, 15).ColumnWidth = 25 ' Virtual IP's
objXLA.Cells(1, 16).ColumnWidth = 15 ' DNS1
objXLA.Cells(1, 17).ColumnWidth = 15 ' DNS2
objXLA.Cells(1, 18).ColumnWidth = 15 ' Interface Type
objXLA.Cells.HorizontalAlignment = 2 ' Drive Count
objXLA.Cells(1, 20).ColumnWidth = 20 ' Virtual IP's
objXLA.Cells(1, 21).ColumnWidth = 20 ' Virtual IP's
' Save
set objFSO2 = CreateObject("Scripting.FileSystemObject")
strFileName = objFSO2.getAbsolutePathName("") & "\Scan Results.xls"
objWorkbook.SaveAs(strFileName)
objWorkbook.Close
objXLA.Quit
' Notify User
WScript.Echo "Process Completed (" & Now & ")"
' Close Program
WScript.Quit(0)

I Need my script modified to run this script and output to CSV but its so big I am not sure where to start. I don't need it in XLS at all, and I can add my own headers, cell sizes and colors, etc. so It should just output the data to a simple CSV.
On Error Resume Next
Dim PUBOSVer ' Global OS Version
' Open File For Writing
Set WshNetwork = WScript.CreateObject("WScript.Network")
Const ForReading = 1
' Get Server List
strServerFilename = "servers.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strServerFilename) Then
' Open Servers File
Set objServers = objFSO.OpenTextFile(strServerFilename, ForReading)
Else
' Server File is missing: Exit
intMsg = MsgBox("File: " & Chr(34) & UCASE(strServerFilename) & Chr(34) & _
" is either " & _
"Missing or Damaged!" & vbcrlf & _
vbcrlf & _
"This Script will now Exit.", vbCritical, "Server File Error")
WScript.Quit(0)
End If
Do Until objServers.AtEndOfStream
strNewServer = Trim(objServers.ReadLine)
strServerList = strServerList & strNewServer & vbcrlf
intServerCnt = intServerCnt + 1
Loop
' Enumerate Server Array
For a = 0 To intServerCnt - 1
strServer = Split(strServerList, vbcrlf)
Next
' Create Excel Spreadsheet
Set objXLA = CreateObject("Excel.Application")
objXLA.Visible = False
objXLA.DisplayAlerts = False
Set objWorkbook = objXLA.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)
'Excel Constants
Const xlEdgeLeft = 7
Const xlContinuous = 1
Const xlNone = -4142
Const xlMedium = -4138
Const xlThin = 2
'Set Headers
' System Information
objXLA.Cells(1,1).Value = "Service ID"
objXLA.Cells(1,2).Value = "Company Name"
objXLA.Cells(1,3).Value = "Manufacturer"
objXLA.Cells(1,4).Value = "Model"
objXLA.Cells(1,5).Value = "Operating System"
' Processors
objXLA.Cells(1,6).Value = "Processor Type"
objXLA.Cells(1,7).Value = "Processors"
' RAM
objXLA.Cells(1,8).Value = "RAM"
objXLA.Cells(1,9).Value = "Slots"
objXLA.Cells(1,10).Value = "Max Capacity"
' Network
objXLA.Cells(1,11).Value = "NIC Port"
objXLA.Cells(1,12).Value = "Speed"
objXLA.Cells(1,13).Value = "Connection Name"
objXLA.Cells(1,14).Value = "Primary IP"
objXLA.Cells(1,15).Value = "Virtual IP"
objXLA.Cells(1,16).Value = "Primary DNS"
objXLA.Cells(1,17).Value = "Secondary DNS"
' Hard Disks
objXLA.Cells(1,18).Value = "Interface"
objXLA.Cells(1,19).Value = "Physical Disks"
objXLA.Cells(1,20).Value = "Disk Size"
objXLA.Cells(1,21).Value = "Fault Tolerant"
objXLA.Cells(1,22).Value = "Hot Spare"
' Set Top Line
objXLA.Cells(1, 1).EntireRow.Font.Bold = True
objXLA.Cells(1, 1).EntireRow.Font.Underline = True
For b = 0 To UBound(strServer) - 1
strServerParts = Split(strServer(b), " ")
strComputer = strServerParts(0)
' Parse Server Information
If UBound(strServerParts) = 2 Then
strUsername = Trim(strServerParts(1))
strPassword = Trim(strServerParts(2))
End If
' Create Connection Object
Set objWMIService = Nothing
Set objSWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objSWbemLocator.ConnectServer _
(strComputer, "root\cimv2", strUsername, strPassword)
objWMIServices.Security_.ImpersonationLevel = 3
' Check if Server Exists
For intWMICheck = 0 To 15
If Not objWMIService Is Nothing Then
Exit For
Else
WScript.Sleep(1000)
End If
Next
' Server Exists
If intWMICheck < 15 Then
' Get CPU Information
Set colProcessor = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
For Each colProc In colProcessor
strManuf = colProc.Manufacturer
strDescription = ProcessorName(colProc.Name)
strClockSpeed = colProc.CurrentClockSpeed
strSocket = strSocket & colProc.SocketDesignation & vbcrlf
strProcID = strProcID & colProc.ProcessorID & vbcrlf
strUniqueID = strUniqueID & colProc.UniqueID & vbcrlf
ProcCount = ProcCount + 1
Next
' Determine if Hyperthreading is Enabled
strHTStatus = GetHTStatus(strSocket, ProcCount, strProcID, strUniqueID)
' DC / HT Results
If strHTStatus = "True" Then
If InStr(strManuf, "Intel") Then
strDescription = strDescription & " (Dual Core or H/T)"
Else
strDescription = strDescription & " (Dual Core)"
End If
ProcCount = ProcCount / 2
End If
' Export Information
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colCS = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
' Write Basic System Information
For Each objItem in colCS
Set colOS = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)
For Each objItemOS in colOS
' Get SP Version
If objItemOS.CSDVersion <> "" Then
strSPVersion = objItemOS.CSDVersion
Else
strSPVersion = "No Service Packs Installed"
End If
If objItemOS.LastBootUpTime <> "" Then
strLastBoot = DateConvert(objItemOS.LastBootUpTime)
Else
strLastBoot = "N/A"
End If
' Set OS Version Information
PUBOSVer = objItemOS.Caption
objXLA.Cells(b + 2, 1).Value = objItemOS.csname
objXLA.Cells(b + 2, 3).Value = objItem.Manufacturer
objXLA.Cells(b + 2, 4).Value = objItem.Model
objXLA.Cells(b + 2, 5).Value = PUBOSVer & " - " & strSPVersion
objXLA.Cells(b + 2, 6).Value = strDescription
objXLA.Cells(b + 2, 7).Value = ProcCount
objXLA.Cells(b + 2, 8).Value = MemoryConvert(objItem.TotalPhysicalMemory)
Next
Next
' Get Memory Breakdown
Dim strMemBreak
strMemBreak = Split(MemoryBreakdown(), vbcrlf)
n = 0
For n = 0 To UBound(strMemBreak) - 1
strSlots = strSlots & strMemBreak(n) & Chr(10)
Next
strMaxCapacity = strMemBreak(UBound(strMemBreak))
objXLA.Cells(b + 2, 9).Value = Left(strSlots, Len(strSlots) - 1)
objXLA.Cells(b + 2, 10).Value = strMaxCapacity
' Dispose
strMemBreak = ""
strMaxCapacity = ""
strSlots = ""
'--------------Computer Information (End)------------------'
'-------------Partition Information (Start)----------------'
' Get Drive Count
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set DiskItemsParent = objWMIService.ExecQuery("Select * from Win32_DiskDrive")
intCount = DiskItemsParent.Count
' Process Drives
intDriveMark = 0
For i = 0 To intCount - 1
Set DiskItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE Index = " & i)
For Each diskItem in DiskItems
' Convert Drive Size
If diskItem.Size <> "" Then strSize = strSize & ByteConvert(diskItem.Size) & Chr(10) Else strSize = "N/A" & Chr(10)
If diskItem.StatusInfo <> "" Then strStsInfo = diskItem.StatusInfo Else strStsInfo = "N/A"
If diskItem.SCSIBus <> "" Then strSCSIBus = diskItem.SCSIBus Else strSCSIBus = "N/A"
If diskItem.SCSILogicalUnit <> "" Then strSCSILog = diskItem.SCSILogicalUnit Else strSCSILog = "N/A"
If diskItem.SCSIPort <> "" Then strSCSIPort = diskItem.SCSIPort Else strSCSIPort = "N/A"
If diskItem.SCSITargetId <> "" Then strSCSITarget = diskItem.SCSITargetId Else strSCSITarget = "N/A"
' Get Model
strModel = Split(diskItem.Model, " ")
' Detect HP Array
If (UCase(strModel(0)) = "HP" Or UCase(strModel(0)) = "COMPAQ") And intDriveMark = 0 Then
strGetHPArray = GetHPArray(strComputer, strUsername, strPassword)
If strGetHPArray <> "" Then
strSplitHP = Split(strGetHPArray, Chr(13))
For a = 0 To UBound(strSplitHP)
strSplitResult = Split(strSplitHP(a), ":")
i = i + 1
strDriveCount = strDriveCount & Trim(strSplitResult(0)) & Chr(10)
strDriveSize = strDriveSize & Trim(strSplitResult(1)) & Chr(10)
strDriveFault = strDriveFault & Trim(strSplitResult(2)) & Chr(10)
strDriveSpare = strDriveSpare & Trim(strSplitResult(3)) & Chr(10)
strInterface = strInterface & "HP SCSI" & Chr(10)
Next
' Set Controller Output
objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
intDriveMark = 1 ' Mark That Data was Obtained
Else
strDriveCount = strDriveCount & "1" & Chr(10)
strDriveSize = strDriveSize & strSize & Chr(10)
strDriveFault = strDriveFault & "N/A" & Chr(10)
strDriveSpare = strDriveSpare & "N/A" & Chr(10)
strInterface = strInterface & "HP SCSI " & Chr(10)
' Set Controller Output
intDriveMark = 1 ' Mark That Another Pass is Invalid
' Set Controller Output
objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
End If
Else
strDriveCount = strDriveCount & "1" & Chr(10)
strDriveSize = strDriveSize & strSize & Chr(10)
strDriveFault = strDriveFault & "N/A" & Chr(10)
strDriveSpare = strDriveSpare & "N/A" & Chr(10)
' Set Controller Output
intDriveMark = 1 ' Mark That Another Pass is Invalid
' Set Controller Output
objXLA.Cells(b + 2, 19).Value = Trim(Left(strDriveCount, Len(strDriveCount) - 1))
objXLA.Cells(b + 2, 20).Value = Trim(Left(strDriveSize, Len(strDriveSize) - 1))
objXLA.Cells(b + 2, 21).Value = Trim(Left(strDriveFault, Len(strDriveFault) - 1))
objXLA.Cells(b + 2, 22).Value = Trim(Left(strDriveSpare, Len(strDriveSpare) - 1))
' Set Interface
If diskItem.InterfaceType = "IDE" Then
strInterface = strInterface & "ATA" & Chr(10)
Else
strInterface = strInterface & "SATA/SCSI" & Chr(10)
End If
End If
' Set Cell Value "Interface"
objXLA.Cells(b + 2, 18).Value = Left(strInterface, Len(strInterface) - 1)
Next
' Dispose Drive Sizes
strDriveSize = ""
Next
' Dispose Drive Values
strDriveCount = ""
strDriveFault = ""
strDriveSpare = ""
strInterface = ""
'----Partition Information (End)---------------------------'
'----Network Information (Start)---------------------------'
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter")
i = 1
eth = 0
Dim STOREDIP(0)
intNum = 0
For Each objItem in colItems
If objItem.NetConnectionStatus <> "" Then
' Determine Connection Status
If objItem.NetConnectionStatus = 0 Then
strNetStat = "Disabled"
ElseIf objItem.NetConnectionStatus = 2 Then
strNetStat = "Connected"
ElseIf objItem.NetConnectionStatus = 7 Then
strNetStat = "Disconnected"
Else
strNetStat = "Unknown"
End If
If objItem.NetConnectionStatus <> 0 Then
' Get Network Card Information
Const HKEY_LOCAL_MACHINE = &H80000002
strKeyPath1 = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters"
strKeyPath2 = "SYSTEM\CurrentControlSet\Services\NetBT\Parameters"
strHostEntry = "Hostname"
strDomainEntry = "Domain"
strNodeEntry = "DhcpNodeType"
strRoutingEntry = "IPEnableRouter"
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strHostEntry,strHostname
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath1,strDomainEntry,strDomain
objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath2,strNodeEntry,dwNodeType
objReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath1,strRoutingEntry,dwIPRouting
Select Case dwNodeType
Case 4 strNodeType = "Mixed"
Case 8 strNodeType = "Hybrid"
Case Else strNodeType = dwNodeType
End Select
If dwIPRouting = 0 Then
strIPRouting = "No"
ElseIf dwIPRouting = 1 Then
strIPRouting = "Yes"
Else
strIPRouting = "?"
End If
Set colFirstNicConfig = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objFirstNicConfig In colFirstNicConfig
strDnsWins = objFirstNicConfig.DNSEnabledForWINSResolution
Next
Set colNicConfigs = objWMIService.ExecQuery _
("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
' Display per-adapter settings.
For Each objNicConfig In colNicConfigs
intIndex = objNicConfig.Index
Set objNic = objWMIService.Get("Win32_NetworkAdapter.DeviceID=" & intIndex)
' Connection Name
If GetOsVer > 5 Then
' Works only in XP / 2003
strNetConn = objNic.NetConnectionID
ElseIf GetOsVer = 5 Then
strNetConn = ""
' Get Home Drive of Remote Server
Set objShell = CreateObject("WScript.Shell")
Set objEtherName = objShell.Exec("cmd /c ipconfig | find " & Chr(34) & "Ethernet" & Chr(34))
strEtherName = objEtherName.StdOut.ReadAll()
strEtherParse = Split(strEtherName, Chr(13))
strEtherConn = Split(strEtherParse(eth), " ")
For y = 2 To UBound(strEtherConn)
strNetConn = strNetConn & " " & strEtherConn(y)
Next
' Trim Connection Name
strNetConn = Left(Trim(strNetConn), Len(Trim(strNetConn)) - 1)
Else
strNetConn = ""
End If
' IP Addresses
strIPAddresses = ""
If Not IsNull(objNicConfig.IPAddress) Then
For Each strIPAddress In objNicConfig.IPAddress
strIPAddresses = strIPAddresses & strIPAddress & " "
Next
End If
strIPCollection = Split(strIPAddresses, " ")
' Subnets
strIPSubnets = ""
If Not IsNull(objNicConfig.IPSubnet) Then
For Each strIPSubnet In objNicConfig.IPSubnet
strIPSubnets = strIPSubnets & strIPSubnet & " "
Next
End If
strSMCollection = Split(strIPSubnets, " ")
' Virtual IP's
strVirtual = ""
If UBound(strIPCollection) > 1 Then
For IPCount = 1 To UBound(strIPCollection) - 1
strVirtual = strVirtual & (strIPCollection(IPCount) & " / " & strSMCollection(IPCount)) & Chr(10)
Next
strVirtual = Left(strVirtual, Len(strVirtual) - 1)
End If
If Trim(strVirtual) = "" Then strVirtual = "N/A"
' Gateways
strDefaultIPGateways = ""
If Not IsNull(objNicConfig.DefaultIPGateway) Then
For Each strDefaultIPGateway In objNicConfig.DefaultIPGateway
strDefaultIPGateways = strDefaultIPGateways & strDefaultIPGateway & " "
Next
Else
strDefaultIPGateways = "N/A"
End If
' If IP is repeated, and was already reported.
intSkipLoop = 0
If Trim(strNetConn) <> "" Then
For j = 0 To intNum - 1
If STOREDIP(j) = strIPAddresses Then
intSkipLoop = 1
Exit For
End If
Next
If intSkipLoop = 0 Then
ReDim Preserve STOREDIP(intNum)
STOREDIP(intNum) = strIPAddresses
intNum = intNum + 1
End If
Else
intSkipLoop = 1
End If
' DNS
strDNSServerSearchOrder = ""
If Not IsNull(objNicConfig.DNSServerSearchOrder) Then
For Each strDNSServer In objNicConfig.DNSServerSearchOrder
strDNSServerSearchOrder = strDNSServerSearchOrder & strDNSServer & " "
Next
strDNS = Split(strDNSServerSearchOrder, " ")
strDNS1 = strDNS(0)
If Trim(strDNS1) = "" Then strDNS1 = "N/A"
If UBound(strDNS) > 1 Then
strDNS2 = strDNS(1)
Else
strDNS2 = "N/A"
End If
Else
strDNS1 = "N/A"
strDNS2 = "N/A"
End If
' Run Output Process
If intSkipLoop = 0 Then
' Connection Speed
strSpeed = "Unknown"
Set objWMIService2 = objSWbemLocator.ConnectServer _
(strComputer, "root\WMI", strUsername, strPassword)
objWMIServices.Security_.ImpersonationLevel = 3
Set listAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_LinkSpeed")
Set enumAdapters = objWMIService2.ExecQuery("SELECT * FROM MSNdis_EnumerateAdapter")
For Each objAdapter in listAdapters
For Each objEnum in enumAdapters
intEnum = Len(objEnum.DeviceName)
If objNicConfig.SettingID = Right(objEnum.DeviceName, intEnum - 8) Then
If objEnum.InstanceName = objAdapter.InstanceName Then
intLength = Len(objAdapter.NdisLinkSpeed/10000)
If intLength > 3 Then
strSpeed = Left(objAdapter.NdisLinkSpeed/10000, intLength - 3)
strSpeed = strSpeed & ".0 Gbps"
Else
strSpeed = objAdapter.NdisLinkSpeed/10000 & " Mbps"
End If
End If
End If
Next
Next
strTotalDesc = strTotalDesc & objNicConfig.Description & Chr(10)
strTotalSpeed = strTotalSpeed & strSpeed & Chr(10)
strTotalNetConn = strTotalNetConn & strNetConn & Chr(10)
strPrimaryIP = strPrimaryIP & strIPCollection(0) & " / " & strSMCollection(0) & Chr(10)
strDNSTotal1 = strDNSTotal1 & strDNS1 & Chr(10)
strDNSTotal2 = strDNSTotal2 & strDNS2 & Chr(10)
strTotalVirtual = strTotalVirtual & strVirtual & Chr(10)
i = i + 1
eth = eth + 2
' Dispose
strDescription = ""
ProcCount = 0
strClockSpeed = ""
strInterface = ""
intCount = 0
strSize = ""
strSpeed = ""
strIPCollection = ""
strVirtual = ""
strDNS = ""
strDNS1 = ""
strDNS2 = ""
End If
Next
' Output
' Trim Leading Chr(10)
If Left(strPrimaryIP, 1) = Chr(10) Then strPrimaryIP = Right(strPrimaryIP, Len(strPrimaryIP) - 1)
If Left(strTotalVirtual, 1) = Chr(10) Then strTotalVirtual = Right(strTotalVirtual, Len(strTotalVirtual) - 1)
If Left(strDNSTotal1, 1) = Chr(10) Then strDNSTotal1 = Right(strDNSTotal1, Len(strDNSTotal1) - 1)
If Left(strDNSTotal2, 1) = Chr(10) Then strDNSTotal2 = Right(strDNSTotal2, Len(strDNSTotal2) - 1)
objXLA.Cells(b + 2, 11).Value = Trim(Left(strTotalDesc, Len(strTotalDesc) - 1))
objXLA.Cells(b + 2, 12).Value = Trim(Left(strTotalSpeed, Len(strTotalSpeed) - 1))
objXLA.Cells(b + 2, 13).Value = Trim(Left(strTotalNetConn, Len(strTotalNetConn) - 1))
objXLA.Cells(b + 2, 14).Value = Trim(Left(strPrimaryIP, Len(strPrimaryIP) - 1))
objXLA.Cells(b + 2, 15).Value = Trim(Left(strTotalVirtual, Len(strTotalVirtual) - 1))
objXLA.Cells(b + 2, 16).Value = Trim(Left(strDNSTotal1, Len(strDNSTotal1) - 1))
objXLA.Cells(b + 2, 17).Value = Trim(Left(strDNSTotal2, Len(strDNSTotal2) - 1))
End If
End If
' Dispose Per Loop
strTotalDesc = ""
strTotalSpeed = ""
strTotalNetConn = ""
strPrimaryIP = ""
strDNSTotal1 = ""
strDNSTotal2 = ""
strTotalVirtual = ""
Set eth = 0
Set i = 0
Next
'------------Network Information (End)------------------'
Else
'No Data Present
objXLA.Cells(b + 2, 1).Value = strComputer
objXLA.Cells(b + 2, 3).Value = "Information Not Available"
objXLA.Cells(b + 2, 1).EntireRow.Font.Bold = True
objXLA.Cells(b + 2, 1).EntireRow.Interior.ColorIndex = 44
End If
' Dispose Per Server
ProcCount = 0
strSocket = ""
strProcID = ""
strUniqueID = ""
Set objWMIService = Nothing
Next
'-----------------Functions (Start)---------------------'
' System Memory Conversion
Function MemoryConvert(strMem)
Dim intLength
Dim intExp
Dim intSize
Dim strSize
Dim strMeasure
Dim strMemory
intLength = Len(strMem)
If (intLength Mod 4 = 0) Then
intExp = CInt((intLength / 3) - 2)
Else
intExp = CInt((intLength / 3) - 1)
End If
' Convert to Lowest Integer Value
For intCount = 1 To Len(intExp)
chrRead = Mid(intExp, intCount, 1)
If chrRead = "." Then
Exit For
Else
strRead = strRead & chrRead
End If
Next
intExp = Cint(strRead)
intSize = CLng(strMem / (2 ^ (intExp * (10))))
If Len(intSize) = 1 Then
strFormat = FormatNumber(CStr(intSize), 2)
Else
strFormat = intSize + 1
End If
If (intExp = 1) Then
strMeasure = "KB"
ElseIf (intExp = 2) Then
strMeasure = "MB"
ElseIf (intExp = 3) Then
strMeasure = "GB"
ElseIf (intExp = 4) Then
strMeasure = "TB"
ElseIf (intExp = 5) Then
strMeasure = "PB"
ElseIf (intExp = 6) Then
strMeasure = "EB"
End If
MemoryConvert = strFormat & " " & strMeasure
End Function
' System Byte Conversion
Function ByteConvert(strMem)
Dim intLength
Dim intExp
Dim intSize
Dim strSize
Dim strMeasure
Dim strMemory
intLength = Len(strMem)
If (intLength Mod 3 = 0) Then
intExp = (intLength / 3) - 1
Else
intExp = (intLength / 3)
End If
' Convert to Lowest Integer Value
For intCount = 1 To Len(intExp)
chrRead = Mid(intExp, intCount, 1)
If chrRead = "." Then
Exit For
Else
strRead = strRead & chrRead
End If
Next
intExp = Cint(strRead)
intSize = CLng(strMem / (2 ^ (intExp * (10))))
strFormat = FormatNumber(CStr(intSize), 2)
If (intExp = 1) Then
strMeasure = "KB"
ElseIf (intExp = 2) Then
strMeasure = "MB"
ElseIf (intExp = 3) Then
strMeasure = "GB"
ElseIf (intExp = 4) Then
strMeasure = "TB"
ElseIf (intExp = 5) Then
strMeasure = "PB"
ElseIf (intExp = 6) Then
strMeasure = "EB"
End If
ByteConvert = strFormat & " " & strMeasure
End Function
' System RAID Byte Conversion
Function ByteConvertRAID(strMem)
Dim intLength
Dim intExp
Dim intSize
Dim strSize
Dim strMeasure
Dim strMemory
intLength = Len(strMem)
If (intLength Mod 3 = 0) Then
intExp = (intLength / 3) - 1
Else
intExp = (intLength / 3)
End If
' Convert to Lowest Integer Value
For intCount = 1 To Len(intExp)
chrRead = Mid(intExp, intCount, 1)
If chrRead = "." Then
Exit For
Else
strRead = strRead & chrRead
End If
Next
intExp = Cint(strRead)
intSize = (strMem / (2 ^ (intExp * (10))))
strFormat = FormatNumber(CStr(intSize), 2)
If (intExp = 0) Then
strMeasure = "MB"
ElseIf (intExp = 1) Then
strMeasure = "GB"
ElseIf (intExp = 2) Then
strMeasure = "TB"
ElseIf (intExp = 3) Then
strMeasure = "PB"
ElseIf (intExp = 4) Then
strMeasure = "EB"
End If
ByteConvertRAID = strFormat & " " & strMeasure
End Function
' Trim Processor Description
Function ProcessorName(strName)
Dim intCounter
Dim strRead
Dim chrRead, chrReadMore
For intCounter = 1 to Len(strName)
chrRead = Mid(strName, intCounter, 1)
chrReadMore = Mid(strName, intCounter + 1, 1)
If ((chrRead <> " ") Or ((chrRead = " ") And (chrReadMore <> " "))) Then
strRead = strRead & chrRead
End If
Next
ProcessorName = Trim(strRead)
End Function
' Get Hyper-Threading Status
Function GetHTStatus(strName, intProc, strID, strUnique)
strNameArray = Split(strName, vbcrlf)
strIDArray = Split(strID, vbcrlf)
strUniqueList = Split(strUnique, vbcrlf)
intTotal = 0
' Check Socket Designation
For i = 0 To UBound(strNameArray) - 1
intMark = 1
' Check for Redundancies
For j = i + 1 To UBound(strNameArray) - 1
If strNameArray(i) = strNameArray(j) Then
intMark = 0
End If
Next
' If Redundant Unique ID's Exist
For j = i + 1 To UBound(strNameArray) - 1
If strUniqueList(i) <> "" And strUniqueList(j) <> "" And _
(strUniqueList(i) <> strUniqueList(j)) Then
intMark = 1
End If
Next
' Check for NULL ProcessorID
If Trim(strIDArray(i)) = "0000000000000000" Then
intMark = 0
End If
' Calculate Total
If intMark = 1 Then
intTotal = intTotal + intMark
End If
Next
' Compare Results
If intProc = 2 * intTotal Then
GetHTStatus = "True"
Else
GetHTStatus = "False"
End If
End Function
' Get Memory Breakdown
Function MemoryBreakdown
Set colPMAItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemoryArray",,48)
For Each objPMAItem in colPMAItems
lngMax = CLng(objPMAItem.MaxCapacity)
intCount = CInt(objPMAItem.MemoryDevices)
Next
ReDim Preserve strPMArray(intCount)
Set colPMItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",,48)
For Each objPMItem in colPMItems
strValue = strValue & objPMItem.DeviceLocator & ": "
strValue = strValue & objPMItem.Capacity / 2^20 & "MB, "
strValue = strValue & objPMItem.Speed & "MHz"
strPMArray(TrimTrailingNumber(objPMItem.Tag)) = strValue
strValue = ""
Next
j = 0
strResult = ""
For j = 0 To intCount - 1
If Trim(strPMArray(j)) = "" Then strPMArray(j) = "<Empty>"
strResult = strResult & strPMArray(j) & vbcrlf
Next
strResult = strResult & (lngMax / 2^10) & "MB"
MemoryBreakdown = strResult
End Function
' Get Part Name
Function ExtractPartName(strName)
Dim chrRead
Dim strRead
Dim i
For i = 2 To Len(strName)
chrRead = Mid(strName, Len(strName) - (i - 1), 1)
If chrRead <> Chr(34) Then
strRead = chrRead & strRead
Else
Exit For
End If
Next
ExtractPartName = strRead
End Function
' Get Trailing Number
Function TrimTrailingNumber(strNum)
Dim chrRead
Dim strRead
Dim intLen
strNum = Trim(strNum)
intLen = Len(strNum)
i = 1
For i = 1 To intLen
chrRead = Mid(strNum, intLen - (i - 1), 1)
If IsNumeric(chrRead) = "True" Then
strRead = chrRead & strRead
Else
Exit For
End If
Next
TrimTrailingNumber = strRead
End Function
' Function: WMIDateStringToDate(dtmDate)
Function WMIDateToString(dtmDate)
WMIDateToString = CDate(Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & _
Left(dtmDate, 4) & " " & _
Mid(dtmDate, 9, 2) & ":" & _
Mid(dtmDate, 11, 2) & ":" & _
Mid(dtmDate, 13, 2))
End Function
' Function: GetOsVer
Function GetOsVer
Set colOperatingSystems = objWMIService.ExecQuery _
("Select * from Win32_OperatingSystem")
For Each objOperatingSystem In colOperatingSystems
GetOSVer = CSng(Left(objOperatingSystem.Version, 3))
Next
End Function
' Function: GetHPArray
Function GetHPArray(strComputer2, strUsername2, strPassword2)
' Check for 64-bit Windows
If InStr(PUBOSVer, "x64") Then
strCompaq = "Program Files (x86)\Compaq\Cpqacuxe\Bin"
Else
strCompaq = "Program Files\Compaq\Cpqacuxe\Bin"
End If
' Create Connection Object
Set objWMIServiceRem = objWMIService.Get("Win32_Process")
' Confirm Location of Compaq Array Manager
Set objHPShell = CreateObject("WScript.Shell")
Set objHPFSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork2 = WScript.CreateObject("WScript.Network")
WshNetwork2.MapNetworkDrive "", "\\" & strComputer2 & "\C$" ,,strUsername2, strPassword2
strProgram = "\\" & strComputer2 & "\C$\" & strCompaq & "\cpqacuxe.exe"
' Ensure Access is Possible
If objHPFSO.FileExists(strProgram) Then
' Process Array Config
strProcess = Chr(34) & "C:\" & strCompaq & "\cpqacuxe.exe" & Chr(34) & " -c c:\output.txt"
Process = objWMIServiceRem.Create(strProcess, null, null, intProcessID)
' Check for "output.txt"
For intTimerHP = 0 To 10
If objFSO.FileExists("\\" & strComputer2 & "\C$\output.txt") Then
Exit For
Else
WScript.Sleep(1000)
End If
Next
' Process Output
If intTimerHP < 10 Then
' Check for Locked Output File
Set objHPOutputFile = objHPFSO.GetFile("\\" & strComputer2 & "\C$\output.txt")
If objHPOutputFile.Size <> 0 Then
' Close File
Set objHPOutputFile = Nothing
' Continue Processesing File
Set objHPInputFile = objHPFSO.OpenTextFile("\\" & strComputer2 & "\C$\output.txt", ForReading)
Do Until objHPInputFile.AtEndOfStream
strHPArray = strHPArray & objHPInputFile.ReadLine & vbcrlf
Loop
' Close Input File
objHPInputFile.Close
' Close Link to Server
objHPFSO.DeleteFile("\\" & strComputer2 & "\C$\output.txt")
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
' Create String Array
strHPParse = Split(strHPArray, vbcrlf)
' Parse For Individual RAID Arrays
Dim strArrayList()
z = 0
For i = 0 To UBound(strHPParse)
j = 0
' Array and Drives
If InStr(strHPParse(i), "Array Specifications") Then
ReDim Preserve strArrayList(z)
strArrayList(z) = strArrayList(z) & strHPParse(i) & vbcrlf
For j = i + 1 To Ubound(strHPParse)
If InStr(strHPParse(j), "Array Specifications") Then
Exit For
Else
strArrayList(z) = strArrayList(z) & strHPParse(j) & vbcrlf
End If
Next
z = z + 1
End If
Next
' Process Each RAID Array
x = 0
For x = 0 To UBound(strArrayList)
strListParse = Split(strArrayList(x), vbcrlf)
For y = 0 To UBound(strListParse)
' Drives
If Left(strListParse(y), 6) = "Drive=" Then
strDrives = ""
strDrives = Split(strListParse(y), ",")
k = 0
For j = 0 To UBound(strDrives)
k = k + 1
Next
strDriveCount = k ' For Output
End If
' Hot Spare
If InStr(strListParse(y), "OnlineSpare=") Then
If InStr(strListParse(y), "OnlineSpare= No") Then
strHotSpare = strHotSpare & "N" ' For Output
Else
strHotSpare = strHotSpare & "Y" ' For Output
End If
End If
' Logical Drives
If InStr(strListParse(y), "Logical Drive Specifications") Then
' Find First Logical Drive
strRAID = Split(strListParse(y + 2), " ")
strRAIDResult = strRAIDResult & "RAID " & strRAID(1) & " / " ' For Output
strGetDrive = Split(strListParse(y + 3), " ")
strRAIDSize = strRAIDSize & ByteConvertRAID(strGetDrive(1)) & " / " ' For Output
End If
Next
' Process Results
strRAIDSize = Left(strRAIDSize, Len(strRAIDSize) - 3)
strRAIDResult = Left(strRAIDResult, Len(strRAIDResult) - 3)
strNewList = strNewList & strDriveCount & _
":" & strRAIDSize & ":" & strRAIDResult & ":" & strHotSpare & Chr(13)
' Dispose Array Variables
strDriveCount = ""
strRAIDSize = ""
strRAIDResult = ""
strHotSpare = ""
Next
' Return Array Output
GetHPArray = Left(strNewList, Len(strNewList) - 1)
Exit Function
Else ' "output.txt" Is Locked
' Close File
Set objHPOutputFile = Nothing
' Kill Remote Connection
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
GetHPArray = ""
Exit Function
End If
Else ' "output.txt" Does not Exist
' Kill Remote Connection
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
GetHPArray = ""
Exit Function
End If
Else ' "Array Manager Does not Exist
' Input not Available
Set objGetHPArray = objHPShell.Exec("net use \\" & strComputer2 & "\C$ /delete /yes")
Do While (objGetHPArray.Status = 0)
WScript.Sleep(500)
Loop
GetHPArray = ""
Exit Function
End If
End Function
'--------------------Functions (End)--------------------'
' Set Excel Attributes
Const xlVAlignTop = -4160
Set objRange2 = objWorksheet.UsedRange
objRange2.VerticalAlignment = xlVAlignTop
' Set Font Attributes
objXLA.Cells.Font.Size = 8
objXLA.Cells.Font.Name = "Arial"
objXLA.Cells.Font.ColorIndex = 11
objXLA.Cells.EntireColumn.AutoFit
objXLA.Cells(1, 9).ColumnWidth = 30 ' RAM Slots
objXLA.Cells(1, 11).ColumnWidth = 40 ' NIC Port
objXLA.Cells(1, 13).ColumnWidth = 25 ' Connection Name
objXLA.Cells(1, 14).ColumnWidth = 25 ' Interface IP's
objXLA.Cells(1, 15).ColumnWidth = 25 ' Virtual IP's
objXLA.Cells(1, 16).ColumnWidth = 15 ' DNS1
objXLA.Cells(1, 17).ColumnWidth = 15 ' DNS2
objXLA.Cells(1, 18).ColumnWidth = 15 ' Interface Type
objXLA.Cells.HorizontalAlignment = 2 ' Drive Count
objXLA.Cells(1, 20).ColumnWidth = 20 ' Virtual IP's
objXLA.Cells(1, 21).ColumnWidth = 20 ' Virtual IP's
' Save
set objFSO2 = CreateObject("Scripting.FileSystemObject")
strFileName = objFSO2.getAbsolutePathName("") & "\Scan Results.xls"
objWorkbook.SaveAs(strFileName)
objWorkbook.Close
objXLA.Quit
' Notify User
WScript.Echo "Process Completed (" & Now & ")"
' Close Program
WScript.Quit(0)

How to get Report Output in csv format

Hi,
How can i get report Output in csv format, can any one tell me the word used for output type to get output in csv format.
i have used XLS output type but it opens in excel format.
conc.addLayout(appCode,concReqCode,"en-US","US",XLS);
Thanks
Babu

Hi Babu,
Till now in xmlpublisher there is no method to create file in csv format ,you have to create Excel file and then save it in .csv format.Unless and until ur using BI Publisher in which some work around are possible.
Thanks

Saving a report with two query providers into .csv format

Hi,
I have developed a webi report which has two query providers. I have linked the objects from these two queries at the report level using merged dimensions. the report is running fine. When I save it in EXCEL or PDF it saves the same report, but when I try to save the report in .CSV format, the output of the second query provided is getting appened at the bottom of the report.
Has anyone encountered similar problem is so whats the solution for it.
For me business wants the report to be saved as .csv only as it acts as a source file to other application.

Hi
please take a look at the explanation area in the following note
https://css.wdf.sap.corp/sap/support/notes/1417382
When saving Web Intelligence document as Excel format, the result is saved based on the report design.
When saving Web Intelligence document as CSV format, all data in the Data Provider are saved.
I believe that the behaviour you described is by design so there is not much to do about it. You can open a case by SAP support though asking if this changed in a later service pack (actual service pack version for XI R2 is SP 6).
Regards,
Stratos

Export Query records to CSV in Excel automatically

Hi Experts
I have a query, where by my queries dont output to CSV automatically, even when I save as .csv it still doesn't work. I found SAP Note 1248146 but it's not very clear... I can not find the 'edit' 'export to excel' you help a bit more please?
Many thanks,
Caroline

Hi Gordon,
Many thanks for this.
My customer wants to be able to export directly into CSV format though, is this possible please?
Many thanks,
Caroline

I need to monitor a transducer block parameter and save it to a CSV file.

How can I monitor a transducer block parameter and save it to a CSV file? The reason is that I need to do some long-term testing of an FFb device we are developing, and I need to read the primary output parameter of the transducer block (not the scheduled AI block) every second or two and save to a CSV file.
I have tried to figure out a way to do that with FBUS Configurator, unsuccessfully, and I purchased FBUS Monitor, as that was recommended by an industry expert, but I have been unsuccessful at getting that to work as well.

Hi Wpinson,
Neither FBUS Configurator nor Monitor can meet your requirement. However, there are other approaches. NI-FBUS provides APIs for C, LabVIEW, VB and C#. You can use these APIs to read a parameter value of any block and use standard file IO functions to save the date into CSV file. The LabVIEW APIs are highly recommended because they are easy-to-use and LabVIEW also provides APIs for CSV file operations. You can build the application w/ LabVIEW in a short time.
You can find the examples of the FBUS APIs in the following folders:
1. C: C:\Program Files\National Instruments\NI-FBUS\MS Visual C\examples
2. VB: C:\Program Files\National Instruments\NI-FBUS\MS Visual Basic\example
3. C#: C:\Program Files\National Instruments\NI-FBUS\MS .NET\examples\CsharpExample
4. LabVIEW: search "fieldbus" in the LabVIEW example finder.

Change layout of Adhoc query output list for Custom infotype

Hi All,
The fields in the Infoset query output on a custom infotype are aligned with the fields u2018payment typeu2019 and u2018amountu2019 appearing repeatedly(in columns) as declared in the Infotype and the output will be a long horizontal list.
Instead, the requirement is that the output list should show vertically so that If I choose u2018Payment Typeu2019 and u2018Amountu2019 as output fields, it will show a long vertical list as in the case of a standard infotype (IT0008).
Also, this way enables user to use Payment Type as a selection criteria so as to just pulling the needed payment type. When we use IT0008 in the infoset it works fine but in custom IT it does not work.
Any pointers/suggestions on how we can achieve this would be helpful.

Hi yu liang,
You can find vendor list having Vendor No. & without showing total liability for every vendor.
after executing the report,
1.You need to select "change layout (ctrl+F8)",
a small window comes, it has two part -> column content & hidden fields.
then u select "Vendor" from hidden field & move it to column content.
2. at column content there is a column named "Total". u need to remove check for your column name "amount".
now select "copy" button or enter. u will find the req. report.
u can save it also by ur name.
hope its helpful to u.......
plz, reward points as a way of thanks if helpful...

To download the query output to falt file

Hi all,
i have a query which i know will give more than 65k records as the output for a selection.
i cannot run this query in excel due to its limitation.
if i run on web i cannot download this as downloading is happening to excel file only.
The customer ideally wants to download the query result to a text file(csv,tab-delimited etc) which inturn it will upload to MS-Access.
How do i achieve this?
SAP has given response use try using these options:
1.open interfaces to receive the output of a query via the MDX language.
2.open hub tool as it is designed for big amounts of data.(i suppose this is not possible as i want to download query output not the data target contents)
how do i achieve my scenario with option 1?
Are there any alternatives??
Any useful help will be rewarded.
Regards,
Dhanya.

hi vivek,
thnks for the useful reply.
i have some problem with my ID,hence loggin in through my coleague's ID.
i will assign u points as i get logged in.
I did as u said by downloading it to unconverted format.
the file got download to a text file.where the output has
1.header rows(10 lines almost)
2.the values r coming in single quotes e,g:
'144000023073 'TAAS SETTLEMENT CONV 738 '19333000 '30.09.2006 '0.000
how can i remove all this?
Regards,
Dhanya
I

Query Output to download in flat file through APD or other means?

Hello Experts,
I am currently on BW3.5 system and have requirement to load query output in flat file in .csv format. I checked the option of APD but looks like we cant directly load the query output in flat file like in APD (BW 3.5 system) .
One way i can think of it...load the query output in transactional ODS and built an infospoke on it to write into flat file.
Please advice if there are any better methods to store the query output in flat files.
Thanks!

Hi,
Use RSCRM_BAPI.
See
Re: RSCRM_Bapi
See the help on RSCRM_BAPI
Re: Running Quaries automatically and saving them in as a Excel file in Server
Re: Data transfer to external systems
Re: Loading from a Custom R/3 Table
Re: How can I schedule my Bex report to execute in background
Re: How can I insert the RSCRM_BAPI into Process chain?
Thanks
Reddy

Save query output as .csv, .xls

Similar Messages

Maybe you are looking for