Compañeros(as)
Encontre esta rutina donde me dice que se puede grabar un directorio entero con sus subcarpetas pero no me funciona.
Necesito ayuda ya que en mi proyecto tengo que respldar la base de datos la idea es que juntaramos fuerza entre todos para ver si podemos sacar el problema...bueno esperando que resulte y sigamos compartiendo conocimientos les dejo la rutina con sus explicaciones.
*************CODIGO*************
'Se declaran las variables del formulario , públicas a todas las funciones y procedimientos
Dim FSOImagen As FileSystemObject
Dim WithEvents MiNero As Nero
Dim PistaISONero As NeroISOTrack
Dim Dispositivos As INeroDrives
Dim WithEvents Grabadora As NeroDrive
Private Sub Form_Initialize()
Set FSOImagen = New FileSystemObject
Set MiNero = New Nero
Set PistaISONero = New NeroISOTrack
Set Dispositivos = MiNero.GetDrives(NERO_MEDIA_CD)
'Aqui se establece la unidad correcta (la grabadora de CDs en mi caso es la 1)
'Podeis averiguar que dispositivo es la grabadora mirando en las propiedades de Dispositivos.
'Dispositivos(numDispositivo).DeviceName por ejemplo sería una buena pista.
Set Grabadora = Dispositivos(1)
Call RealizarGrabacion
End Sub
Private Sub Form_Terminate()
Set Grabadora = Nothing
Set Dispositivos = Nothing
Set PistaISONero = Nothing
Set MiNero = Nothing
Set FSOImagen = Nothing
End Sub
Private Sub RealizarGrabacion()
Dim NombreDirectorioRaiz As String
Dim EtiquetaCD As String
Call InterpretarArgumentos(NombreDirectorioRaiz, EtiquetaCD)
Call CrearImagenCD(NombreDirectorioRaiz, EtiquetaCD)
Call GrabarImagenCD
Unload Me
End Sub
'Este procedimiento interpreta los argumentos que se pasan al ejecutar el programa desde la
'línea de argumentos y guarda dichos argumentos (solo necesitamos uno o dos) en las variables
'que le pasamos como parámetros por referencia.
Private Sub InterpretarArgumentos(ByRef RutaDirectorioOrigen As String, ByRef EtiquetaCD As String)
Dim ArrayArgumentos() As String
If Command$ = "" Then
MsgBox "No se han pasado argumentos al programa"
Else
'La instruccion Split es una maravilla.
ArrayArgumentos = Split(Command$, " ")
RutaDirectorioOrigen = ArrayArgumentos(0)
EtiquetaCD = ArrayArgumentos(1)
'El segundo argumento es opcional , en caso de que no se pase se utiliza por ejemplo la fecha
'como etiqueta de volumen.
If EtiquetaCD = "" Then
EtiquetaCD = Date
End If
End If
End Sub
'Este procedimiento crea la "imagen" del CD a partir de los archivos y subdirectorios que
'cuelgan del directorio inicial que le especifiquemos
'Con lo cual todos los archivos y subdirectorios de ese directorio origen que está en el disco
'duro o en otro dispositivo de almacenamiento se grabaran a partir del directorio raiz del cd.
Public Sub CrearImagenCD(ByVal RutaDirectorioOrigen As String, ByVal EtiquetaCD As String)
Dim Archivo As File
Dim DirectorioOrigen As Folder
Dim SubDirectorio As Folder
Dim ArchivoNero As NeroFile
Dim DirectorioRaizNero As NeroFolder
If RutaDirectorioOrigen <> "" Then
Set DirectorioOrigen = FSOImagen.GetFolder(RutaDirectorioOrigen)
'Se crea primero el directorio raiz del CD.
Set DirectorioRaizNero = New NeroFolder
'He preferido añadir primero los archivos a la imagen del cd y luego ir uno a uno añadiendo los
'directorios que directamente cuelgan del directorio origen o inicial.
'La razón de todo esto es por seguir un orden y para realizar en un futuro un control sobre el
'tamaño de todo lo que se quiere ir metiendo en el CD , asi se sumarian los tamaños de los
'archivos y directorios que vayamos añadiendo , teniendo cuidado de no sorepasar la capacidad del CD.
'Una vez creado el directorio raiz del CD se le añaden primero los archivos.
For Each Archivo In DirectorioOrigen.Files
Set ArchivoNero = New NeroFile
ArchivoNero.Name = Archivo.Name
ArchivoNero.SourceFilePath = Archivo.Path
DirectorioRaizNero.Files.Add ArchivoNero
Next Archivo
'Se añaden despues todos los directorios que cuelgan del directorio raiz del cd
'con sus respectivos subdirectorios al nero folder , mediante una llamada a AñadirDirectorio
'Añadir directorio de forma recursiva ira añadiendo los subdirectorios de los directorios que
'cuelgan directamente del directorio origen o inicial
For Each SubDirectorio In DirectorioOrigen.SubFolders
DirectorioRaizNero.Folders.Add AnadirDirectorio(SubDirectorio)
Next SubDirectorio
'Se establecen los valores para la Pista ISO del CD
PistaISONero.Name = EtiquetaCD
PistaISONero.RootFolder = DirectorioRaizNero
PistaISONero.BurnOptions = NERO_BURN_OPTION_CREATE_ISO_FS + NERO_BURN_OPTION_RELAX_JOLIET
Else
MsgBox "No se ha especificado una ruta válida para el directorio origen", vbInformation
End If
End Sub
'Esta funcion devuelve un Directorio NeroFolder. Esto hace fácil añadir el arbol de
'directorioscompleto a un Directorio NeroFolder existente.
Public Function AnadirDirectorio(ByVal Dir As Folder) As NeroFolder
Dim Archivo As File
Dim Directorio As Folder
Dim ArchivoNero As NeroFile
Dim DirectorioNero As NeroFolder
'Se crea un nuevo Directorio NeroFolder y se renombra.
Set DirectorioNero = New NeroFolder
DirectorioNero.Name = Dir.Name
'Se añaden todos los archivos al directorio nero folder
For Each Archivo In Dir.Files
Set ArchivoNero = New NeroFile
ArchivoNero.Name = Archivo.Name
ArchivoNero.SourceFilePath = Archivo.Path
DirectorioNero.Files.Add ArchivoNero
Next
'Se añaden todos los directorios al nero folder , mediante llamadas recursivas
For Each Directorio In Dir.SubFolders
DirectorioNero.Folders.Add AnadirDirectorio(Directorio)
Next
'Se devuelve finalmente este directorio.
Set AnadirDirectorio = DirectorioNero
End Function
'Este procedimiento es el que finalmente graba el CD.
Private Sub GrabarImagenCD()
'Se graba el CD utilizando la pista generada por el procedimiento CrearImagenCD.
'Se especifican las opciones correspondientes a lo que queremos hacer , un CD de datos.
Grabadora.BurnIsoAudioCD "Artista", "Titulo", 0, PistaISONero, Nothing, Nothing, NERO_BURN_FLAG_WRITE, 16, NERO_MEDIA_CD
End Sub
'Por ultimo , implementamos los manejadores de dos de los eventos de la grabadora.
Private Sub Grabadora_OnProgress(ProgressInPercent As Long, Abort As Boolean)
Me.LblProgreso.Caption = ProgressInPercent & "%"
End Sub
Private Sub Grabadora_OnDoneBurn(StatusCode As NEROLib.NERO_BURN_ERROR)
MsgBox "CD Grabado", vbInformation
End Sub
A MI ME ARROJA ESTE ERROR ....... ERROR DE COMPILACION NO SE A DEFINIDO EL TIPO DEFINIDO POR EL USUARIO ME MARCA ESTA LINEA
Dim FSOImagen As FileSystemObject
BUENO COMPAÑEROS ESPERANDO SU APOYO Y TIEMPO SE AGRADECE ANTEMANO.
SALUDOS DESDE VIÑA DEL MAR, CHILE
