在excel vba中使用IMAPI刻录dvd(s)

我在使用IMAPI时遇到运行时错误。 错误:

添加文件或文件夹将导致结果图像的尺寸大于当前configuration的限制。

它适用于任何不超过光驱中媒体types的东西,否则我会得到上述结果。

我在这里看到了一篇来自A_J的文章,它倾向于使用C#的一个可能的解决scheme:

fileSystemImage.FreeMediaBlocks = int.MaxValue; 

我正在寻找上面的帮助,但在2013 Excel VBA。

以下是我正在使用的副本:

 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