AppendChunk sólo es necesario si el campo que quieres grabar es muy grande, más de 32000 caracteres, si no alcanza ese tamaño se guarda como un campo de texto. Si es necesario, lo que se hace es ir grabando "pedazos" más pequeños usando AppendChunk en un bucle.
El siguiente código funciona. Lo uso para guardar un formulario completo en una tabla; luego en un proceso inverso, desde esa tabla puedo recuperar el formulario en cualquier aplicación, en concreto, lo uso en un complemento para insertar un formulario calendario
'---------------------------------------------------------------------------------------
' Procedure : FormACampo
' DateTime : 20/07/06 22:51
' Author : José Bengoechea Ibaceta (Chea)
' Purpose : Guardar un formulario en un campo Objeto de una tabla para poder exportarlo
' desde un MDB. Exportamos a texto el formulario, leemos el texto y lo guardamos en la tabla
' Estás autorizado a utilizar este código dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web, por favor,
' contactar con el autor en
'
'
[email protected]
'---------------------------------------------------------------------------------------
Public Sub FormaCampo(NombreForm As String)
Dim stPath As String
Dim fNum As Long, FileSize As Long, BytesRead As Long
Dim Rst1 As New ADODB.Recordset
Dim RutaArchivo As String
On Error GoTo FormaCampo_Error
RutaArchivo = "Ztemporal"
stPath = CurrentProject.Path
Application.SaveAsText acForm, NombreForm, RutaArchivo
With Rst1
.Open "USysObjects", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
End With
Dim BLOCK_SIZE As Long
BLOCK_SIZE = 32768
fNum = FreeFile
Open RutaArchivo For Binary As #fNum
FileSize = LOF(fNum)
Rst1.AddNew
Do While FileSize <> BytesRead
If FileSize - BytesRead < BLOCK_SIZE Then
ReDim bData(FileSize - BytesRead) As Byte
bData = InputB(FileSize - BytesRead, fNum)
BytesRead = FileSize
Else
ReDim bData(BLOCK_SIZE) As Byte
bData = InputB(BLOCK_SIZE, fNum)
BytesRead = BytesRead + BLOCK_SIZE
End If
Rst1.Fields("Object").AppendChunk bData
Loop
Rst1.Fields("Type") = acForm
Rst1.Fields("Name") = NombreForm
Rst1.Update
Close #fNum
FormaCampo_Salida:
On Error GoTo 0
Exit Sub
FormaCampo_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormaCampo of Módulo ModWz"
GoTo FormaCampo_Salida
End Sub
