Wie erkennt man das Laufwerk eines Memory Sticks?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Marcel!
Eine Möglichkeit.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

'Deklaration: Globale Form API-Funktionen
Private Declare Function GetDriveType 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 GetVolumeInformation Lib "kernel32" _
  Alias "GetVolumeInformationA" (ByVal lpRootPathName _
  As String, ByVal pVolumeNameBuffer As String, ByVal _
  nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
  lpMaximumComponentLength As Long, lpFileSystemFlags As _
  Long, ByVal lpFileSystemNameBuffer As String, ByVal _
  nFileSystemNameSize As Long) As Long

'Deklaration: Globale Form API-Konstanten
Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_RAMDISK As Long = 6
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_REMOVABLE As Long = 2
Private Const MAX_FILENAME_LEN As Long = 256&

Public Function SerNum(Drive$) As Long
Dim No As Long, s As String * MAX_FILENAME_LEN

Call GetVolumeInformation(Drive & ":\", s, MAX_FILENAME_LEN, _
  No, 0&, 0&, s, MAX_FILENAME_LEN)
SerNum = No
End Function

Private Sub SearchForUSB_Stick()
Dim lngResult As Long, lngPuffer As Long, lngTyp As Long, x As Long
Dim strDrive As String, strDrives As String, strPuffer As String
Dim blnFound As Boolean

'Speicherplatz reservieren
lngPuffer = 64
strPuffer = Space$(lngPuffer)

'Laufwerksbuchstaben ermitteln
lngResult = GetLogicalDriveStrings(lngPuffer, strPuffer)
strDrives = Left$(strPuffer, lngResult)

Do While x < Len(strPuffer)
  x = InStr(strPuffer, vbNullChar)

  If x <> 0 Then
    strDrive = Left$(strPuffer, x)
    strPuffer = Mid$(strPuffer, x + 1, Len(strPuffer))

    'Laufwerkstyp ermitteln
    lngTyp = GetDriveType(strDrive)
    If lngTyp <> 1 Then
      Select Case lngTyp
        Case DRIVE_CDROM

        Case DRIVE_FIXED

        Case DRIVE_RAMDISK

        Case DRIVE_REMOTE

        Case DRIVE_REMOVABLE
          strDrive = UCase(Mid$(strDrive, 1, 1))
          'zum Ermitteln der Seriennummer (Ausgabe im Direktfenster!)
          Debug.Print strDrive & ": Seriennummer:= "; SerNum(strDrive)

          'Zum starten der Prozedur
          If SerNum(strDrive) = 841419846 Then 'hier die ermittelte Seriennummer eintragen!
            blnFound = True
            deinMakro (strDrive)
          End If
        Case Else
      End Select
    End If
  Else
    Exit Do
  End If
Loop

If Not blnFound Then
  MsgBox "USB-Stick nicht gefunden!"
End If
End Sub

Sub deinMakro(ByVal strDrive As String)
MsgBox "USB-Stick gefunden als Laufwerk " & strDrive & ":\"
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Wie erkennt man das Laufwerk eines Memory Sticks?

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread