unidad de cd

Gemma,

Creo q habra q recurrir al codigo VBA y especificamente a las llamadas API
de Windows. Abajo te pongo un codigo basado en las funciones creadas por
John Walkenbach. Tienes q ir al Editor VBA, crear un nuevo modulo, pegar el
codigo ahi y lanzar el macro BuscarCDRom.

Saludos,
KL

'-Inicio Codigo
Option Explicit

' 32-bit API declarations

Private Declare Function GetDriveType32 Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function GetDiskFreeSpace Lib "kernel32" _
Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) _
As Long

Private Function DriveType(DriveLetter As String) As String
Dim DLetter
Dim DriveCode
' Returns a string that describes the drive type

DLetter = Left(DriveLetter, 1) & ":"
DriveCode = GetDriveType32(DLetter)

Select Case DriveCode
Case 1: DriveType = "Local"
Case 2: DriveType = "Removable"
Case 3: DriveType = "Fixed"
Case 4: DriveType = "Remote"
Case 5: DriveType = "CD-ROM"
Case 6: DriveType = "RAM Disk"
Case Else: DriveType = "Unknown Drive Type"
End Select
End Function

Private Function NumberofDrives() As Integer
' Returns the number of drives

Dim Buffer As String * 255
Dim BuffLen As Long
Dim DriveCount As Integer
Dim i

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)
DriveCount = 0
' Search for a null -- which separates the drives
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) = 0 Then _
DriveCount = DriveCount + 1
Next i
NumberofDrives = DriveCount
End Function

Private Function DriveName(index As Integer) As String
' Returns the drive letter using an index
' Returns an empty string if index > number of drives

Dim Buffer As String * 255
Dim BuffLen As Long
Dim TheDrive As String
Dim DriveCount As Integer
Dim i

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)

' Search thru the string of drive names
TheDrive = ""
DriveCount = 0
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) <> 0 Then _
TheDrive = TheDrive & Mid(Buffer, i, 1)
If Asc(Mid(Buffer, i, 1)) = 0 Then 'null separates drives
DriveCount = DriveCount + 1
If DriveCount = index Then
DriveName = UCase(Left(TheDrive, 1))
Exit Function
End If
TheDrive = ""
End If
Next i
End Function

Sub BuscarCDRom()
Dim i As Integer
Dim DLetter As String
Dim NumDrives As Integer
Dim contador As Integer

NumDrives = NumberofDrives()

For i = 1 To NumDrives
DLetter = DriveName(i)
If DriveType(DLetter) = "CD-ROM" Then
MsgBox DLetter & ":\ es un CD-ROM"
contador = contador + 1
End If
Next i
MsgBox "Se han encontrado " & contador & " CD-ROM(s)"
End Sub
'-Fin Codigo


"gemma" wrote in message
news:150101c4fd83$c481f1d0$

Que tal, espero me puedan ayudar:

Necesito detectar la unidad de CD-Room, por lo regular se
encuentra en D:, pero tengo equipos en los que cambia la
letra, como puedo hacer para detectar en que letra esta
dicha unidad?

Gracias Anticipadas

Gracias KL funciona perfecto pero diras que mientras mas
te dan mas quiero

crees que sea posible expulsar la charola del cd (eject)

ojala me puedas ayudar

Saludos
Gemma

Gemma,

Creo q habra q recurrir al codigo VBA y especificamente a

las llamadas API

de Windows. Abajo te pongo un codigo basado en las

funciones creadas por

John Walkenbach. Tienes q ir al Editor VBA, crear un

nuevo modulo, pegar el

codigo ahi y lanzar el macro BuscarCDRom.

Saludos,
KL

'-Inicio Codigo
Option Explicit

' 32-bit API declarations

Private Declare Function GetDriveType32 Lib "kernel32" _
Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Declare Function GetLogicalDriveStrings

Lib "kernel32" _

Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As

Long, _

ByVal lpBuffer As String) As Long

Private Declare Function GetDiskFreeSpace Lib "kernel32" _
Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As

String, _

lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters

As Long) _

As Long

Private Function DriveType(DriveLetter As String) As

String

Dim DLetter
Dim DriveCode
' Returns a string that describes the drive type

DLetter = Left(DriveLetter, 1) & ":"
DriveCode = GetDriveType32(DLetter)

Select Case DriveCode
Case 1: DriveType = "Local"
Case 2: DriveType = "Removable"
Case 3: DriveType = "Fixed"
Case 4: DriveType = "Remote"
Case 5: DriveType = "CD-ROM"
Case 6: DriveType = "RAM Disk"
Case Else: DriveType = "Unknown Drive Type"
End Select
End Function

Private Function NumberofDrives() As Integer
' Returns the number of drives

Dim Buffer As String * 255
Dim BuffLen As Long
Dim DriveCount As Integer
Dim i

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)
DriveCount = 0
' Search for a null -- which separates the drives
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) = 0 Then _
DriveCount = DriveCount + 1
Next i
NumberofDrives = DriveCount
End Function

Private Function DriveName(index As Integer) As String
' Returns the drive letter using an index
' Returns an empty string if index > number of drives

Dim Buffer As String * 255
Dim BuffLen As Long
Dim TheDrive As String
Dim DriveCount As Integer
Dim i

BuffLen = GetLogicalDriveStrings(Len(Buffer), Buffer)

' Search thru the string of drive names
TheDrive = ""
DriveCount = 0
For i = 1 To BuffLen
If Asc(Mid(Buffer, i, 1)) <> 0 Then _
TheDrive = TheDrive & Mid(Buffer, i, 1)
If Asc(Mid(Buffer, i, 1)) = 0 Then 'null

separates drives

DriveCount = DriveCount + 1
If DriveCount = index Then
DriveName = UCase(Left(TheDrive, 1))
Exit Function
End If
TheDrive = ""
End If
Next i
End Function

Sub BuscarCDRom()
Dim i As Integer
Dim DLetter As String
Dim NumDrives As Integer
Dim contador As Integer

NumDrives = NumberofDrives()

For i = 1 To NumDrives
DLetter = DriveName(i)
If DriveType(DLetter) = "CD-ROM" Then
MsgBox DLetter & ":\ es un CD-ROM"
contador = contador + 1
End If
Next i
MsgBox "Se han encontrado " & contador & " CD-ROM(s)"
End Sub
'-Fin Codigo


"gemma" wrote in

message

news:150101c4fd83$c481f1d0$

Que tal, espero me puedan ayudar:

Necesito detectar la unidad de CD-Room, por lo regular

se

encuentra en D:, pero tengo equipos en los que cambia la
letra, como puedo hacer para detectar en que letra esta
dicha unidad?

Gracias Anticipadas

.

Gemma,

"Gemma" wrote in message...

crees que sea posible expulsar la charola del cd (eject)

Este codigo me funciona a mi. Desconozco como se portara si hay mas de un
CD-Roms en la maquina.

Saludos,
KL

'-Inicio Codigo--
' Need to include a reference to winmm.dll
' Use Tools > References > Browse
'
Public Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" _
(ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long

Public Sub EjectCD()
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0&
End Sub

Public Sub CloseCD()
mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0&
End Sub
'-Fin Codigo--

Gracias KL funciona de maravilla

Gemma,

"Gemma" wrote in message...

crees que sea posible expulsar la charola del cd (eject)

Este codigo me funciona a mi. Desconozco como se portara

si hay mas de un

CD-Roms en la maquina.

Saludos,
KL

'-Inicio Codigo--
' Need to include a reference to winmm.dll
' Use Tools > References > Browse
'
Public Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" _
(ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long

Public Sub EjectCD()
mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0&
End Sub

Public Sub CloseCD()
mciSendString "Set CDAudio Door Closed Wait", 0&,

0&, 0&

End Sub
'-Fin Codigo--


.