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