CD Schublade geschlossen: Weiter
04.11.2021 06:29:12
Andreas
mit nachfolgender Funktion brenne ich derzeit meine CDs. Funktioniert auch soweit so gut, zumindest an einem Rechner mit 64bit. Beim 32Bit Excel komme ich derzeit noch nicht dahinter, warum es nicht funktioniert. Er bricht den Brennvorgang immer erfolglos ab.
Jetzt zu meiner Frage: Ich lasse das CD Laufwerk ja mit der Funktion unten öffnen und schließen.
64 bit
Private Declare PtrSafe Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
32. Bit
Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
......
Call mciExecute("Set CDaudio door open")
MsgBox "Bitte einen Datenträger (CD/DVD) in das Laufwerk einlegen und bestätigen.", vbInformation, "Elektronisches Tagebuch"
Call mciExecute("Set CDaudio door closed")
....
Allerdings kommt es hin und wieder zu Problemen, wenn der User das OK nicht betätigt. Kann man die Msgbox ausblenden, bzw. das OK bestätigen lassen, sobald die CD Schublade wieder eingefahren ist ? Sprich: Kann man den Status der Schublade als auslösendes Event irgendwie abfangen?
Vielen Dank voran
hier der gesamte Code.
Public Function Brenne_DVD(ByVal path As String, ByVal TextBox3 As String)
Dim Index ' Index to recording drive.
Dim Recorder ' Recorder object
Dim Stream ' Data stream for burning device
Dim g_DiscMaster
Dim FSI ' Disc file system
Dim Dir ' Root directory of the disc file system
Dim dataWriter
Dim result
Dim uniqueId
Index = 0 ' First and only drive on the system
Call mciExecute("Set CDaudio door open")
MsgBox "Bitte einen Datenträger (CD/DVD) in das Laufwerk einlegen und bestätigen.", vbInformation, "Elektronisches Tagebuch"
Call mciExecute("Set CDaudio door closed")
Call UF_Brennvorgang.Show
Set g_DiscMaster = CreateObject("IMAPI2.MsftDiscMaster2")
Set Recorder = CreateObject("IMAPI2.MsftDiscRecorder2")
uniqueId = g_DiscMaster.Item(Index)
Recorder.InitializeDiscRecorder (uniqueId)
Set FSI = CreateObject("IMAPI2FS.MsftFileSystemImage")
Set Dir = FSI.Root
'Create the new disc format and set the recorder
Set dataWriter = CreateObject("IMAPI2.MsftDiscFormat2Data")
dataWriter.Recorder = Recorder
dataWriter.ClientName = "IMAPIv2 TEST"
FSI.ChooseImageDefaults (Recorder)
FSI.VolumeName = TextBox3
' Add the directory and its contents to the file system
Dir.AddTree path, False
' Create an image from the file system
Set result = FSI.CreateResultImage()
' Write stream to disc using the specified recorder.
On Error GoTo Errorhandler:
dataWriter.Write (result.ImageStream)
Call Unload(Object:=UF_Brennvorgang)
Call mciExecute("Set CDaudio door open")
MsgBox ("Brennvorgang erfolgreich beendet." & Chr(10) & "Bitte Datenträger entnehmen und beschriften."), vbInformation
Exit Function
Errorhandler:
Call Unload(Object:=UF_Brennvorgang)
Call mciExecute("Set CDaudio door open")
MsgBox ("Der Vorgang konnte nicht ordnungsgemäß abgeschlossen werden." & Chr(10) & Chr(10) & "Bitte prüfen Sie den Datenträger. Möglicherweise ist dieser beschädigt oder wurde nicht eingelegt."), vbCritical
End Function