none
VBA verb for "Finish burning" RRS feed

  • Question

  • I have a database, photo manager.  The client needs to write records (photos) to DVD.  Everything works short of finalizing the disk.  The DVD windows pops up and I cannot find out to finalize the disk.  Thanks

    Public Sub btnDVD_Click()
        
        Dim db As DAO.Database
        Dim rs As DAO.Recordset
        Dim sqlStr As String
    
        'Provide the drive letter of your CD burner
        strDriveLetter = InputBox("Driveletter: ", "Driveletter", "D") & ":\"
        ' error handeling for cancle
        If strDriveLetter = ":\" Then
         MsgBox "Export Cancled!"
         Exit Sub
       Else
       End If
         'Provide the source directory. We made one on the c drive
         'and everything we put in this directory will be put on a cd
        strSourceDirectory = path
         'Provide a volume name for your CD (16 characters max)
        strCDName = Date
        Const MY_COMPUTER = &H11
        Set WshShell = CreateObject("WScript.Shell")
        Set objShell = CreateObject("Shell.Application")
        strBurnDirectory = WshShell.RegRead( _
        "HKCU\Software\Microsoft\Windows\CurrentVersion\" _
        & "Explorer\Shell Folders\CD Burning")
        Set objFolder = objShell.Namespace(strSourceDirectory)
        
        GetFolder = strDriveLetter
        'For each copy
       
    
        ' select images matching case ID from from
        sqlStr = "SELECT * FROM tbl_images WHERE caseid =" & Me.txt_caseid
    
        Set db = CurrentDb
        Set rs = db.OpenRecordset(sqlStr)
    
            rs.MoveFirst
    
            While (Not rs.EOF)
            path = rs("path")
            pathid = rs("ID")
      ' copy file name last name, and path ID
      objShell.Namespace(strBurnDirectory).CopyHere path, GetFolder & "\" & Me.casenumber.Value & "_" & "_" & pathid & ".jpeg"
      
      rs.MoveNext
    
            Wend
            
        ' write files to cd, and open dialot
        
        objShell.Namespace(&H11&).ParseName(strDriveLetter).InvokeVerbEx ( _
        "Write &these files to CD")
        
        objShell.Namespace(&H11&).ParseName(strDriveLetter).InvokeVerbEx CDBurningCommand
        
        
    
    NoFile:
    End Sub

    Saturday, February 10, 2018 12:32 AM

All replies

  • Hi Intelibyte,

    I try to check the issue and find that your actual issue is related with burning the disk.

    This forum only handles the issues regarding Access Object Model.

    For better response and better solution for your issue, I move this thread to MSDN VBA Forum.

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us.

    Thank you for your understanding.

    Regards,

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, February 12, 2018 6:22 AM
  • I understand. 

    Thanks

    Monday, February 12, 2018 5:54 PM