MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Salvar arquivos no CD diretamente pelo Access

    Pablo Neruda
    Pablo Neruda
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 302
    Registrado : 17/09/2010

    Salvar arquivos no CD diretamente pelo Access Empty Salvar arquivos no CD diretamente pelo Access

    Mensagem  Pablo Neruda em 19/3/2016, 16:13

    Amigos boa tarde!

    Efetuando algumas buscar encontrei esse código que para mim é de grande valia pois uso muito o access para a automatização de processos e esse possibilita a gravação de arquivos em CD/DVD, etc... O código esta cru como encontrei e deixo aqui no intuito de quando da criação de rotinas para sua utilização seja partilhado aqui no forum para enriquecimento do conteúdo e conhecimento dos participantes. Para utilizá-lo tem que ser habilitada 2 referências no access que são:

    - MICROSOFT IMAP2 BASE FUNCTIONALITY
    - MICROSOFT IMAP2 FILE SYSTEM IMAGE CREATOR

    Testei a rotina e funcionou perfeitamente...


    Sub TestCDWrite()
    Dim objDiscMaster As IMAPI2.MsftDiscMaster2
    Dim objRecorder As IMAPI2.MsftDiscRecorder2
    Dim DataWriter As IMAPI2.MsftDiscFormat2Data
    Dim intDrvIndex As Integer
    'The Object browser, but not intellisense, presents types for these, but they cannot be used in VBA
    Dim stream As Variant
    Dim FS As Variant
    Dim Result As Variant
    Dim FSI As Object
    Dim strBurnPath As String
    Dim strUniqueID As String

    ' *** CD/DVD disc file system types
    Const FsiFileSystemISO9660 = 1
    Const FsiFileSystemJoliet = 2
    Const FsiFileSystemUDF102 = 4

    'On Error GoTo TestCDWrite_Error

    intDrvIndex = 0
    strBurnPath = "C:\Toburn"
    ' Create a DiscMaster2 object to connect to optical drives.
    Set objDiscMaster = New IMAPI2.MsftDiscMaster2

    ' Create a DiscRecorder2 object for the specified burning device.
    Set objRecorder = New IMAPI2.MsftDiscRecorder2

    strUniqueID = objDiscMaster.Item(intDrvIndex)
    objRecorder.InitializeDiscRecorder (strUniqueID)

    ' Create a DiscFormat2Data object and set the recorder
    Set DataWriter = New IMAPI2.MsftDiscFormat2Data
    DataWriter.Recorder = objRecorder
    DataWriter.ClientName = "IMAPIv2 TEST"
    DataWriter.ForceMediaToBeClosed = True


    ' Create a new file system image object
    Set FSI = New IMAPI2FS.MsftFileSystemImage


    FS = FSI.ChooseImageDefaults(objRecorder)


    ' Add the directory and its contents to the file system
    Call MsgBox("Adding " & strBurnPath & " folder to the disc. Press OK to continue.", vbInformation, "Burn Batch to CD")
    FSI.Root.AddTree strBurnPath, False

    ' Create an image from the file system image object

    Set Result = FSI.CreateResultImage()
    Set stream = Result.ImageStream

    ' Write stream to disc using the specified recorder
    Call MsgBox("Burn Batch to disc. Press OK to continue.", vbInformation, "Burn Batch to CD")
    DataWriter.Write (stream)

    Call MsgBox("Burn process completed.", vbInformation, "Burn Batch to CD")

    ExitHere:
    Exit Sub
    'Error handling block
    TestCDWrite_Error:
    Select Case Err.Number
    Case Else
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "TestCode.TestCDWrite"
    End Select
    Resume ExitHere
    'End Error handling block


    .................................................................................
    Salvar arquivos no CD diretamente pelo Access Elohim Elohim Manutenção & Sistemas
    ..............Powered by MS Access with VBA code..............

      Data/hora atual: 4/12/2020, 14:08