VBA Tips - Código de exemplo determinar a letra de unidade de CD-ROM - Sample Code to Determine CD-ROM Drive Letter

Termo de Responsabilidade

Aqui coloco um artigo com um código que determina a primeira letra da unidade de CD-ROM, retornando uma variável como string, em seguida mostra numa caixa de mensagens. Isso seria útil para acessar arquivos contidos em um CD.

  ' **********************************************************************     '     ' FUNCTION:     '    GetFirstCdRomDriveLetter()     '     ' PURPOSE:     '    Finds the first CD-ROM device and then returns its drive letter.     '     ' ARGUMENTS:     '    None     '     ' RETURNS:     '    A string that represents the first CD-ROM drive letter. If the     '    function fails for any reason, it returns vbNullString.     '     ' **********************************************************************     Declare Function GetDriveType Lib "kernel32" Alias _        "GetDriveTypeA" (ByVal nDrive As String) As Long       Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _        "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _        ByVal lpBuffer As String) As Long       Public Const DRIVE_CDROM As Long = 5       Function GetFirstCdRomDriveLetter() As String          ' Declare variables.        Dim lDriveType As Long        Dim strDrive As String        Dim lStart As Long: lStart = 1          ' Create a string to hold the logical drives.        Dim strDrives As String        strDrives = Space(150)          ' Get the logial drives on the system.        ' If the function fails it returns zero.        Dim lRetVal As Long        lRetVal = GetLogicalDriveStrings(150, strDrives)          ' Check to see if GetLogicalDriveStrings() worked.        If lRetVal = 0 Then             ' Get GetLogicalDriveStrings() failed.           GetFirstCdRomDriveLetter = vbNullString           Exit Function        End If          ' Get the string that represents the first drive.        strDrive = Mid(strDrives, lStart, 3)          Do             ' Test the first drive.           lDriveType = GetDriveType(strDrive)             ' Check if the drive type is a CD-ROM.           If lDriveType = DRIVE_CDROM Then                ' Found the first CD-ROM drive on the system.              GetFirstCdRomDriveLetter = strDrive              Exit Function           End If             ' Increment lStart to next drive in the string.           lStart = lStart + 4             ' Get the string that represents the first drive.           strDrive = Mid(strDrives, lStart, 3)          Loop While (Mid(strDrives, lStart, 1) <> vbNullChar)     End Function

Segue um exemplo que chama a função GetFirstCdRomDriveLetter()

  Sub Main          Dim strDriveLetter as String          ' Call the GetFirstCdRomDriveLetter() and store the        ' return value in strDriveLetter.        strDriveLetter = GetFirstCdRomDriveLetter()          ' Display the drive letter in a message box.        MsgBox strDriveLetter       End Sub

Reference: 

Tags: VBA, Tips, CR-ROM, Drive Letter