Find all the cd and dvd drives on my network


How can i find all the cd and dvd drives on my networ.
A script which can scan the file in which i have all the machine name.

Scan results
Machine name  CD   DVD
Machinename   Yes   NO
Machinename   Machine not pinging

LVL 11
Who is Participating?
Hi bsharath,

I WARN YOU THIS WILL TAKE A LONG TIME TO RUN.........................  test on a short list first!!!!

This will prompt for a pc list file containing your pc names should be formatted as follows


It will query each machine and return the cd/dvd model information for all optical drives in the pc.  Then save the results into a csv file "pcname,drivemodel,drivemodel" or "pcname,error response" that you can open in excel.

'===Start copy: getcdroms.vbs===
' ---------------------------------------------------------------'
' getcdroms.vbs
' 'Sample VBScript to query remote computers
' 'and return cdrom model information into csv file.
' ''Author Riley C. aka ZooFan
' '''Version 1.7 - August 2007
' '''' question ID: 22746064
' ---------------------------------------------------------------'
Option explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 3 'FileObject Access Type
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 'FileObject Format Type
Dim strPcList
Dim arrPcnames()
Dim strResultsFile
Dim dte
Dim tme
Dim objFso
Dim objWshShell
Dim objPCnames
Dim objReadFile
Dim intLneCount
Dim objOutputFile
Dim strCurPath
Dim intPCLoop
Dim strReturn      
Dim strTestcon
      Set objFso = CreateObject("Scripting.FileSystemObject")
      Set objWshShell = WScript.CreateObject("WScript.Shell")
      strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
      strPcList = InputBox("Please enter the full path and file" & VbCrLf & "name of the file with the computer names.","Get cdrom drives.")
            'Test to make sure file exists if not exit script
            If Not objFso.FileExists(strPcList) Then
                  MsgBox "You must enter a valid full path and file name!",vbOKOnly,"Get cdrom drives."
            Elseif strPcList = "" Then
                  MsgBox "You must enter a filename!",vbOKOnly,"Get cdrom drives."
            Else 'File exists continue
                                    dte = Replace(FormatDateTime(date(),vbshortdate),"/","-")
                                    tme = Replace(Replace(FormatDateTime(now(),vbLongtime),":","-")," ","")
                                          strResultsFile = strCurPath & "\" & tme & "_" & dte & ".csv"
                                                If objFSO.FileExists(strResultsFile) Then
                                                      Set objOutputFile = objFso.CreateTextFile(strResultsFile)
                                                End If
                                                MsgBox strResultsFile
                                    Set objPCnames = objFso.GetFile(strPcList)
                                    Set objReadFile = objPCnames.OpenAsTextStream(ForReading, TristateUseDefault)
                                          Do Until objReadFile.AtEndOfStream
                                                ReDim Preserve arrPCnames(intLneCount)
                                                arrPCnames(intLneCount) = objReadFile.ReadLine
                                                intLneCount = intLneCount + 1
                                          Set objOutputFile = objFso.OpenTextFile(strResultsFile,ForWriting,TristateUseDefault)
                                                For intPCLoop = LBound(arrPCnames) To UBound(arrPCnames)
                                                      strTestcon = IsServerOn(arrPCnames(intPCLoop))
                                                      If strTestcon = "0" then                                                
                                                      strReturn = getcdrom(arrPCnames(intPCLoop))
                                                      objOutputFile.WriteLine(arrPCnames(intPCLoop) & "," & strReturn)
                                                      objOutputFile.WriteLine(arrPCnames(intPCLoop) & "," & strTestcon)
                                                      End If
                                           MsgBox("Script has completed")
                        End If
Function IsServerOn(strserver)                        
      Dim Testme
      Dim intErr
      Dim strRegValue
      Dim strFileServer
      On Error Resume Next
            Set Testme = GetObject("winmgmts://" & strserver & "/root/cimv2")
                  Set strRegValue = GetObject("winmgmts://" & strserver & "/root/default:StdRegProv")
                        intErr = Err.Number
                        If intErr <> 0 Then
                              IsServerOn = Err.Description
                              IsServerOn = "0"
                        End If
      On Error GoTo 0
End Function
Function getcdrom(strcomputer)
Dim GetWMIServices
Dim colItems
Dim getcd
Dim obj
                        Set GetWMIServices = GetObject("winmgmts:" _
                            & "{impersonationLevel=impersonate}!//" & strcomputer & "/root/cimv2")
                        Set colItems = GetWMIServices.ExecQuery("Select * from Win32_CDROMDrive")
                        For Each obj In colItems
                        getCD =
                        getcdrom = getcdrom & "," & getcd
                        If getcdrom = "," then
                         getcdrom = "Error reading drive information"
                         End if
      Set GetWMIServices = Nothing
      Set colItems = Nothing
End Function

Function readtextfile(strTxtFile, arrname())
On Error Resume Next
      Dim intErr, intLines
      Dim objTxtLines, objReadFile,objFso      
            Set objFso = CreateObject("Scripting.FileSystemObject")
            Set objTxtLines = objFso.GetFile(strTxtFile)
            Set objReadFile = objTxtLines.OpenAsTextStream(ForReading, TristateUseDefault)
                  Do Until objReadFile.AtEndOfStream
                        ReDim Preserve arrname(intLines)
                        arrname(intLines) = objReadFile.ReadLine
                        intLines = intLines + 1
            Set objFso = nothing
            Set objTxtLines = Nothing
            Set objReadFile = Nothing
                  intErr = Hex(Err.Number)
                        If intErr <> 0 Then
                              readtextfile = Err.Description
                              readtextfile = "0"
                        End If
On Error GoTo 0                        
End Function

if you have any problems let me know.

Oh it will save the csv file as time_date.csv in the scripts directory and the script will prompt you when its finished( it takes a long time) DO not open the file until you have been prompted that the script is done or you may cause issues with it trying to write to the file.

bsharathAuthor Commented:
Thanks a lot zoofan.
If you can find if there is a cd in the drive i can raise a new Q....
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

before you post it let me test it but 95% sure of a yes,  brb

bsharathAuthor Commented:
Ok zoofan...
Yes I can, post it

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.