copying folder to cd in vb
| Nero & InCD Discuss, copying folder to cd in vb at Burning Software forum; Is is possible to copy a complete folder eg: c:\program files\myapp\data i.e all files and subfolders to a new folder on a cd using vb and neroCOM? |
- #1
| Is is possible to copy a complete folder eg: c:\program files\myapp\data i.e all files and subfolders to a new folder on a cd using vb and neroCOM? |
- Today (MyCE Staff)
- Posts: 15,596
| |
- #2
| Yes it is possible but you have to recursively build the ISO tree yourself. You can see a sample code sent by one of the forum members at: http://club.cdfreaks.com/showthread....threadid=77167 |
- #5
| I have tried the following code in the nero fiddles sample, but the marked line in the copy directory function causes errors, any ideas? Option Explicit Public WithEvents nero As nero Public drives As INeroDrives Public WithEvents drive As NeroDrive Public cnt As Integer Public Folder As INeroFolder Public strMessages As String Dim isotrack As NeroISOTrack Dim file As NeroFile Public Function CopyDirectory(ByVal mySourcePath As String) As Boolean Dim myCurrentFolder Dim myCurrentFolderName As String Dim myFolderObject Dim myfolder Dim mySubFolderList Dim myCopyFile Dim myI As Integer Dim myRememberI As Integer Dim myX Dim myNfolder As New NeroFolder CopyDirectory = False 'MkDir Targetpath Set myFolderObject = CreateObject("Scripting.FileSystemObject") Set myfolder = myFolderObject.GetFolder(mySourcePath) Set mySubFolderList = myfolder.SubFolders For Each myCurrentFolder In mySubFolderList For myI = Len(myCurrentFolder) To 1 Step -1 If Mid$(myCurrentFolder, myI, 1) = "\" Then Exit For End If myRememberI = myI Next If myRememberI <> 1 Then myCurrentFolderName = Right$(myCurrentFolder, Len(myCurrentFolder) - myRememberI + 1) Else myCurrentFolderName = myCurrentFolder End If If Not CopyDirectory(mySourcePath + "\" + myCurrentFolderName) Then Exit Function End If Next 'Set myCopyFile = CreateObject("Scripting.FileSystemObject") 'myX = myCopyFile.CopyFolder(mySourcePath, myTargetpath) myNfolder.Name = mySourcePath Folder.Folders.Add (myNfolder) '---- causes error - object does not support this property or method myX = CopyAllFiles(mySourcePath) If Not myX Then MsgBox "Error Copying Files!" Exit Function End If CopyDirectory = True End Function Public Function CopyAllFiles(ByVal mySourcePath As String) As Boolean Dim myCurrentFile Dim myFolderObject Dim myfolder Dim mySubFileList CopyAllFiles = False Set myFolderObject = CreateObject("Scripting.FileSystemObject") Set myfolder = myFolderObject.GetFolder(mySourcePath) Set mySubFileList = myfolder.Files For Each myCurrentFile In mySubFileList Set file = New NeroFile Folder.Files.Add file file.Name = NameFromPath(edtFileName.Text) file.SourceFilePath = edtFileName.Text drive.BurnIsoAudioCD "Unison", "Backup", 0, isotrack, Nothing, Nothing, NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE, 4, NERO_MEDIA_CD GoTo quit Next handle_error: strMessages = strMessages + Err.Description + Chr(13) + Chr(10) + nero.LastError edtMessages = strMessages quit: End Function Private Sub Burn_Click() Dim Source_Dir As String Dim X As Boolean Source_Dir = "C:\unison\bend" btnAbort.Enabled = True Browse.Enabled = False Burn.Enabled = False Set Folder = New NeroFolder Set drives = nero.GetDrives(NERO_MEDIA_CDR) Set drive = drives(AvailableDevices.ListIndex) Set isotrack = New NeroISOTrack isotrack.Name = "Unison" isotrack.RootFolder = Folder isotrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET X = CopyDirectory(Source_Dir) If Not X Then MsgBox "copy failed!" End If End Sub |
- #6
| Below is the function I use to populate the Nero Folder. You pass it the NeroFolder you want to populate and a FSO folder which is the start point for the file/folder iteration. You would call the sub like this; BuildFileFolderTree nroFolder, fso.GetFolder("C:\") Sub Definition: 'Recursive function to build the Folders/Files to burn Private Sub BuildFileFolderTree(ByRef nroFolderToUse As NeroFolder, folCurrent As Folder) Dim folTMP As Folder Dim filTMP As File Dim nroFolTmp As NeroFolder Dim nroFilTmp As NeroFile 'Add all files in the current directory For Each filTMP In folCurrent.Files Set nroFilTmp = New NeroFile nroFilTmp.Name = filTMP.Name nroFilTmp.SourceFilePath = filTMP.Path nroFolderToUse.Files.Add nroFilTmp Next 'Write the sub folders For Each folTMP In folCurrent.SubFolders Set nroFolTmp = New NeroFolder nroFolTmp.Name = folTMP.Name nroFolderToUse.Folders.Add nroFolTmp BuildFileFolderTree nroFolTmp, folTMP Next End Sub Hope it is of some help. Jason |
- #8
| Thanks for your help, tried the code example suggested but vb won`t run it - says user type not defined on procedure declaration line - presumably one of the nerofolder or folder types isn`t known? Tried removing brackets as suggested and got a bit further, am now getting following error: run time error '-2147220984 (80040208)': An asynchronous operation is in progress! You can`t have two operations at the same time Any ideas? |
- #11
| Tried after the next as you suggest and still get same error, then tried after initial call to copydirectory, i.e. after all subfolders and files added, don`t get any errors but nothing is written to cd and get the following messages: Reading directories Joliet names of these files (listed here in ISO-L3) are the same: Preparation of ISO 9660 structures failed Windows 2000 5.0 IA32 WinAspi: - ahead WinASPI: File 'C:\Program Files\Ahead\Nero\Wnaspi32.dll': Ver=2.0.1.59, size=160016 bytes, created 17/06/2003 13:25:03 Nero API version: 6.0.0.16 Using interface version: 6.0.0.0 Installed in: C:\Program Files\Ahead\Nero\ Application: Nero - Burning Rom\ahead Recorder: Adapter driver: Drive buffer : 2048kB Bus Type : default (0) -> ATAPI, detected: ATAPI === Scsi-Device-Map === DiskPeripheral : ST320014A atapi Port 0 ID 0 DMA: On CdRomPeripheral : Compaq CD-ROM SC-148E atapi Port 1 ID 0 DMA: On CdRomPeripheral : AOPEN CD-RW CRW5224 atapi Port 1 ID 1 DMA: On === CDRom-Device-Map === Compaq CD-ROM SC-148E Q: CDRom0 AOPEN CD-RW CRW5224 R: CDRom1 ======================= AutoRun : 1 Excluded drive IDs: CmdQueuing : 1 CmdNotification: 2 WriteBufferSize: 36700160 (0) Byte ShowDrvBufStat : 0 EraseSpeed : 0 BUFE : 0 Physical memory : 223MB (228852kB) Free physical memory: 51MB (53216kB) Memory in use : 76 % Uncached PFiles: 0x0 Use Static Write Speed Table: 0 Use Inquiry : 1 Global Bus Type: default (0) Check supported media : Disabled (0) 18.12.2003 NeroAPI 09:44:36 #1 Text 0 File Reader.cpp, Line 118 Reader running 09:44:36 #2 ISO9660GEN -11 File geniso.cpp, Line 3861 First writeable address = 0 (0x00000000) 09:44:36 #3 ISO9660GEN -3 File geniso.cpp, Line 2601 Joliet names of these files (listed here in ISO-L3) are the same: 09:44:36 #4 ISO9660GEN -6 File geniso.cpp, Line 3964 Preparation of ISO 9660 structures failed Existing drivers: Registry Keys: HKLM\Software\Microsoft\Windows NT\CurrentVersion\WinLogon\AllocateCDROMs : 0 (Security Option) Preparation of ISO 9660 structures failed Burn finished NOT (3)successfully! |
- #12
| If you want I can email you the code I am using to burn directory contents, but I won't be able to do that until this evening (when I get home from work). The code I have got works for 1 burn, but I am still trying to solve the multisession problem with vb. |
- #13
- #14
| Ok, have now got code which is creating CD, but all files are in the root of the CD rather than in their correct subfolder. How do I choose which folder files go into? For reference latest code follows: Public Function CopyDirectory(ByVal mySourcePath As String) As Boolean Dim myCurrentFolder Dim myCurrentFolderName As String Dim myFolderObject Dim myFolder Dim mySubFolderList Dim myI As Integer Dim myRememberI As Integer Dim myX Dim myNFolder As New NeroFolder CopyDirectory = False Set myFolderObject = CreateObject("Scripting.FileSystemObject") Set myFolder = myFolderObject.GetFolder(mySourcePath) Set mySubFolderList = myFolder.SubFolders For Each myCurrentFolder In mySubFolderList For myI = Len(myCurrentFolder) To 1 Step -1 If Mid$(myCurrentFolder, myI, 1) = "\" Then Exit For End If myRememberI = myI Next If myRememberI <> 1 Then myCurrentFolderName = Right$(myCurrentFolder, Len(myCurrentFolder) - myRememberI + 1) Else myCurrentFolderName = myCurrentFolder End If If Not CopyDirectory(mySourcePath + "\" + myCurrentFolderName) Then Exit Function End If Next myNFolder.Name = NameFromPath(mySourcePath) Folder.Folders.Add myNFolder myX = CopyAllFiles(mySourcePath) If Not myX Then MsgBox "Error Copying Files!" Exit Function End If CopyDirectory = True End Function Public Function CopyAllFiles(ByVal mySourcePath As String) As Boolean Dim myCurrentFile Dim Start Dim X Dim myFolderObject Dim myFolder Dim mySubFileList CopyAllFiles = False Set myFolderObject = CreateObject("Scripting.FileSystemObject") Set myFolder = myFolderObject.GetFolder(mySourcePath) Set mySubFileList = myFolder.Files For Each myCurrentFile In mySubFileList Set File = New NeroFile Folder.Files.Add File File.Name = myCurrentFile.Name File.SourceFilePath = myCurrentFile Next CopyAllFiles = True handle_error: strMessages = strMessages + Err.Description + Chr(13) + Chr(10) + Nero.LastError edtMessages.Text = Trim$(strMessages) quit: End Function Private Sub Burn_Click() Dim Source_Dir As String Dim X As Boolean Source_Dir = "C:\unison\bend" btnAbort.Enabled = True Burn.Enabled = False Set Folder = New NeroFolder Set Drives = Nero.GetDrives(NERO_MEDIA_CDR) Set Drive = Drives(AvailableDevices.ListIndex) Set Isotrack = New NeroISOTrack X = CopyDirectory(Source_Dir) If Not X Then MsgBox "Backup Failed!" End If Isotrack.Name = "Unison" Isotrack.RootFolder = Folder Isotrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET Drive.BurnIsoAudioCD "Unison", "Backup", 0, Isotrack, Nothing, Nothing, NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE, 4, NERO_MEDIA_CD End Sub |
- #15
| Told a slight porky last code wouldn`t create a CD, this code will. But still don`t know how to specify the containing folder Public Function CopyDirectory(ByVal mySourcePath As String) As Boolean Dim myCurrentFolder Dim myCurrentFolderName As String Dim myFolderObject Dim myFolder Dim mySubFolderList Dim myI As Integer Dim myRememberI As Integer Dim myX Dim myNFolder As New NeroFolder Dim CurrentPath As String CopyDirectory = False Set myFolderObject = CreateObject("Scripting.FileSystemObject") Set myFolder = myFolderObject.GetFolder(mySourcePath) Set mySubFolderList = myFolder.SubFolders For Each myCurrentFolder In mySubFolderList For myI = Len(myCurrentFolder) To 1 Step -1 If Mid$(myCurrentFolder, myI, 1) = "\" Then Exit For End If myRememberI = myI Next If myRememberI <> 1 Then myCurrentFolderName = Right$(myCurrentFolder, Len(myCurrentFolder) - myRememberI + 1) Else myCurrentFolderName = myCurrentFolder End If If Not CopyDirectory(mySourcePath + "\" + myCurrentFolderName) Then Exit Function End If Next For myI = Len(mySourcePath) To 1 Step -1 If Mid$(mySourcePath, myI, 1) = "\" Then Exit For End If myRememberI = myI Next If myRememberI <> 1 Then CurrentPath = Right$(mySourcePath, Len(mySourcePath) - myRememberI + 1) Else CurrentPath = mySourcePath End If myNFolder.Name = CurrentPath Folder.Folders.Add myNFolder myX = CopyAllFiles(mySourcePath) If Not myX Then MsgBox "Error Copying Files!" Exit Function End If CopyDirectory = True End Function Public Function CopyAllFiles(ByVal mySourcePath As String) As Boolean Dim myCurrentFile Dim Start Dim X Dim myFolderObject Dim myFolder Dim mySubFileList CopyAllFiles = False Set myFolderObject = CreateObject("Scripting.FileSystemObject") Set myFolder = myFolderObject.GetFolder(mySourcePath) Set mySubFileList = myFolder.Files For Each myCurrentFile In mySubFileList Set File = New NeroFile Folder.Files.Add File File.Name = myCurrentFile.Name File.SourceFilePath = myCurrentFile Next CopyAllFiles = True handle_error: strMessages = strMessages + Err.Description + Chr(13) + Chr(10) + Nero.LastError edtMessages.Text = Trim$(strMessages) quit: End Function Private Sub Burn_Click() Dim Source_Dir As String Dim X As Boolean Source_Dir = "C:\unison\bend" btnAbort.Enabled = True Burn.Enabled = False Set Folder = New NeroFolder Set Drives = Nero.GetDrives(NERO_MEDIA_CDR) Set Drive = Drives(AvailableDevices.ListIndex) Set Isotrack = New NeroISOTrack X = CopyDirectory(Source_Dir) If Not X Then MsgBox "Backup Failed!" End If Isotrack.Name = "Unison" Isotrack.RootFolder = Folder Isotrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET Drive.BurnIsoAudioCD "Unison", "Backup", 0, Isotrack, Nothing, Nothing, NERO_BURN_FLAG_SIMULATE + NERO_BURN_FLAG_WRITE, 4, NERO_MEDIA_CD End Sub |
- #18
| No did not get - it is a shared mailbox and I think someone else must have deleted! Can you send it to my personal email - mikekay2@supanet.com Thanks in advance Mike |
- #19
| Cheers Jason - got round to trying your code and works fine - so put it into my code if thats ok. Copy of my code is below - had several people aking for it. Only problem I have now is making the cd readable in a standard CD Rom drive, presumably there is a flag somewhere for this but I can`t find it - can anyone help? Mike Option Explicit Public WithEvents Nero As Nero Public WithEvents Drive As NeroDrive Dim Drives As INeroDrives Dim Folder As INeroFolder Dim Isotrack As NeroISOTrack Dim File As NeroFile Private Sub cmd_Abort_Click() Nero.Abort End Sub 'Recursive function to build the Folders/Files to burn Private Sub BuildFileFolderTree(ByRef nroFolderToUse As NeroFolder, folCurrent As Folder) Dim folTMP As Folder Dim filTMP As File Dim nroFolTmp As NeroFolder Dim nroFilTmp As NeroFile 'Add all files in the current directory For Each filTMP In folCurrent.Files Set nroFilTmp = New NeroFile nroFilTmp.Name = filTMP.Name nroFilTmp.SourceFilePath = filTMP.Path nroFolderToUse.Files.Add nroFilTmp Next 'Write the sub folders For Each folTMP In folCurrent.SubFolders Set nroFolTmp = New NeroFolder nroFolTmp.Name = folTMP.Name nroFolderToUse.Folders.Add nroFolTmp Call BuildFileFolderTree(nroFolTmp, folTMP) Next End Sub Private Sub cmd_Burn_Click() Dim Source_Dir As String Dim X As Boolean Dim temp Dim FSO As New FileSystemObject Source_Dir = "C:\unison\bend" lst_Messages.Clear cmd_Abort.Enabled = True cmd_Burn.Enabled = False Set Folder = New NeroFolder Set Drives = Nero.GetDrives(NERO_MEDIA_CDR) Set Drive = Drives(lst_AvailableDevices.ListIndex) Set Isotrack = New NeroISOTrack Call BuildFileFolderTree(Folder, FSO.GetFolder(Source_Dir)) Isotrack.Name = "Unison" Isotrack.RootFolder = Folder Isotrack.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_USE_JOLIET If Drive.Capabilities And NERO_CAP_BUF_UNDERRUN_PROT Then Drive.BurnIsoAudioCD "Unison", "Backup", 0, Isotrack, Nothing, Nothing, NERO_BURN_FLAG_WRITE + NERO_BURN_FLAG_BUF_UNDERRUN_PROT, 0, NERO_MEDIA_CD Else Drive.BurnIsoAudioCD "Unison", "Backup", 0, Isotrack, Nothing, Nothing, NERO_BURN_FLAG_WRITE, 0, NERO_MEDIA_CD End If End Sub Private Sub drive_OnAborted(Abort As Boolean) Abort = False End Sub Private Sub drive_OnAddLogLine(TextType As NEROLib.NERO_TEXT_TYPE, Text As String) If Not SplitText(Text) Then MsgBox "Error Splitting Message Data!" End If End Sub Private Function SplitText(ByVal Data As String) As Boolean Dim temp As String Dim I As Integer SplitText = False temp = "" For I = 1 To Len(Data) If Mid$(Data, I, 1) = Chr$(13) Then lst_Messages.AddItem Trim$(temp) temp = "" ElseIf Mid$(Data, I, 1) <> Chr$(10) Then temp = temp + Mid$(Data, I, 1) End If Next If temp <> "" Then lst_Messages.AddItem Trim$(temp) End If If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If SplitText = True End Function Private Sub drive_OnDoneBurn(StatusCode As NEROLib.NERO_BURN_ERROR) Dim strMessages As String If Not SplitText(Nero.ErrorLog) Then MsgBox "Error Splitting Message Data!" End If If Not SplitText(Nero.LastError) Then MsgBox "Error Splitting Message Data!" End If strMessages = "Burn finished " If StatusCode <> NEROLib.NERO_BURN_OK Then strMessages = strMessages + "NOT Successfully (" & StatusCode & ")" Else strMessages = strMessages + "Successfully" End If lst_Messages.AddItem strMessages If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If cmd_Abort.Enabled = False cmd_Burn.Enabled = True pgs_progress1.Value = 0 End Sub Private Sub drive_OnDoneWaitForMedia(Success As Boolean) lst_Messages.AddItem "Done waiting for media." If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If End Sub Private Sub drive_OnProgress(ProgressInPercent As Long, Abort As Boolean) Abort = False pgs_progress1.Value = ProgressInPercent End Sub Private Sub drive_OnSetPhase(Text As String) If Not SplitText(Text) Then MsgBox "Error Splitting Message Data!" End If End Sub Private Sub Form_Initialize() Dim myIndex As Integer Set Nero = New Nero pgs_progress1.Value = 0 lst_Messages.Clear Set Drives = Nero.GetDrives(NERO_MEDIA_CDR) For myIndex = 0 To Drives.Count - 1 lst_AvailableDevices.AddItem Drives(myIndex).DeviceName, myIndex Next 'set to second item (normally would use first or allow to select?) lst_AvailableDevices.ListIndex = 1 ErrHandler: Exit Sub End Sub Private Sub nero_OnMegaFatal() lst_Messages.AddItem "A mega fatal error has occurred." If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If End Sub Private Sub nero_OnNonEmptyCDRW(Response As NEROLib.NERO_RESPONSE) lst_Messages.AddItem "CD-RW not empty!" If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If Response = NERO_RETURN_EXIT End Sub Private Sub nero_OnRestart() lst_Messages.AddItem "The system is being restarted." If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If End Sub Private Sub nero_OnWaitCD(WaitCD As NEROLib.NERO_WAITCD_TYPE, WaitCDLocalizedText As String) If Not SplitText(WaitCDLocalizedText) Then MsgBox "Error Splitting Message Data!" End If End Sub Private Sub nero_OnWaitCDDone() lst_Messages.AddItem "Done waiting for CD." If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If End Sub Private Sub nero_OnWaitCDMediaInfo(LastDetectedMedia As NEROLib.NERO_MEDIA_TYPE, LastDetectedMediaName As String, RequestedMedia As NEROLib.NERO_MEDIA_TYPE, RequestedMediaName As String) lst_Messages.AddItem "Waiting for a particular media type:" If Not SplitText(RequestedMediaName) Then MsgBox "Error Splitting Message Data!" End If End Sub Private Sub nero_OnWaitCDReminder() lst_Messages.AddItem "Still waiting for CD..." If lst_Messages.ListCount <> 0 Then lst_Messages.ListIndex = lst_Messages.ListCount - 1 lst_Messages.Refresh End If End Sub |
- #20
| Hello.... I used the above example (Nice job by the way!) But the problem I am getting is that there are no files showing up on the CD! The CD looks like it burnt (I see the data ring), but explorer shows no files.... There were no error messages given and everything looks like it worked. I'm pretty new to this process..so, I could easliy be missing a 'close CD' or finalize cd option. Thanks. J |
- #22
| Quote:
Anyway, thanks for the tip......great code by the way.... Jimmy |
WIN your own LG N2B1 NAS with 2TB of Storage!*
To win, tell us why you want to win and
tell ,or show us (graphic, video, etc.) why you think Life's Good with LG NAS.
*US only Not registered yet? Register now!
Posting Rules
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
People who found this also searched for
- at burn process we get error 'jolient names of these files (listed here in iso-l3)are same.
- burn data on cd vb.net
- burning data on cd in vb.net
- cd vb
- code for writing file to cd drive using vb6
- compaq-cd-rom-sc-148e-driver
- copy a folder to cd using vb6.0 code
- copy data to cd code vb.net
- copy file with fso on cd
- copy files to cd vb6
- driver for compaq cd-rom sc-148e
- errores nerolib vb.net initialized
- folder cd vb
- folder copy to cd through vb6.0 code
- how to create a new folder in cd using vb6 code
- image recorder nero visual basic
- run time error 2147220984
- speed up copying folder with vb6
- vb cd make new folder
- vb.net copy file to cd from application
- vb6 2147220984
- vb6 burn folder to cd
- vb6 cd burner directory
- vb6 code send to cd-rw
- vb6 copying and replacing folders
- vb6 folder copy
- vba object does not support this property or method filesystemobject

