1

I am encountering a run-time error while using IMAPI. The error:

Adding a file or folder would result in a result image having a size larger than the current configured limit.

It works great for anything that doesn't exceed the type of media in the optical drive, else I get the above.

I saw a post from A_J here that leans toward a possible solution in C#:

fileSystemImage.FreeMediaBlocks = int.MaxValue;

I am looking for help in writing the above, but in 2013 Excel VBA.

Below is a copy of what I'm using:

Option Explicit

Sub TestCDWrite()

Application.DisplayAlerts = False

  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 = Worksheets("mphoi").Range("AF2")
  ' 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"

  ' Create a new file system image object
  Set FSI = New IMAPI2FS.MsftFileSystemImage
  fsi.freemediablocks=int.maxvalue

  ' Import the last session, if the disc is not empty, or initialize
  ' the file system, if the disc is empty
  If Not DataWriter.MediaHeuristicallyBlank Then
    On Error Resume Next
    FSI.MultisessionInterfaces = DataWriter.MultisessionInterfaces
    If Err.Number <> 0 Then
        MsgBox "Multisession is not supported on this disc", vbExclamation, "Data Archiving"
      GoTo ExitHere
    End If
    On Error GoTo 0
        MsgBox "Importing data from previous session ...", vbInformation, "Data Archiving"
    FS = FSI.ImportFileSystem()
  Else
    FS = FSI.ChooseImageDefaults(objRecorder)
  End If

  ' Add the directory and its contents to the file system
    MsgBox "Adding " & strBurnPath & " folder to the disc...", vbInformation, "Data Archiving"
  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
    MsgBox "Writing content to the disc...", vbInformation, "Data Archiving"
  DataWriter.Write (stream)

    MsgBox "Completed writing Archive data to disk ", vbInformation, "Data Archiving"

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

  Application.DisplayAlerts = True
'End Error handling block

End Sub
Community
  • 1
  • 1

0 Answers0