求助!急!请帮助!!!!!!!!!!

我正在做一个试卷生成系统,包括自动出卷和手工两部分,我用的后台数据库是ACCESS涉及到了OLE对象的问题,无法正常导出,我想请问一下,我最后应该怎么让他自动生成试卷,并且试题是随机生成的.非常感谢!

解决方案 »

免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货

隨機用RND函數。
我可以提供技術支持。
MSN：[email protected]
QQ：5507350
大致处理过程如下:
一、假如按试卷ID生成随机数，先使用Randomize初始化随机数生成器，然后使用RND按最小ID到最大ID生成随机要取得试卷ID二、根据生成的试卷ID，取出记录，并按如下函数，获取该BLOB字段到一文件'使用如下获取该字段到一文件，
Public Function ReadbolbToFile(blobColumn As ADODB.Field, ByVal FileName As String) As Boolean
'³ÌÐò¶þ: ¶ÁÊý¾Ýº¯Êý
    Dim FileNumber      As Integer      'ÎÄ¼þºÅ
    Dim DataLen             As Long         'ÎÄ¼þ³¤¶È
    Dim Chunks              As Long         'Êý¾Ý¿éÊý
    Dim ChunkAry()      As Byte         'Êý¾Ý¿éÊý×é
    Dim ChunkSize       As Long         'Êý¾Ý¿é´óÐ¡
    Dim Fragment        As Long         'ÁãËéÊý¾Ý´óÐ¡
    Dim lngI                As Long '¼ÆÊýÆ÷

    On Error GoTo ErrorHandle
    ReadbolbToFile = False
    ChunkSize = 2048                    '¶¨Òå¿é´óÐ¡Îª 2K
    If blobColumn Is Nothing Then Exit Function

    DataLen = blobColumn.ActualSize         '»ñµÃÍ¼Ïñ´óÐ¡

    If DataLen < 8 Then Exit Function   'Í¼Ïñ´óÐ¡Ð¡ÓÚ8×Ö½ÚÊ±ÈÏÎª²»ÊÇÍ¼ÏñÐÅÏ¢

    FileNumber = FreeFile               '²úÉúËæ»úµÄÎÄ¼þºÅ
    Open FileName For Binary Access Write As FileNumber     '´ò¿ª´æ·ÅÍ¼ÏñÊý¾ÝÎÄ¼þ
    Chunks = DataLen \ ChunkSize        'Êý¾Ý¿éÊý
    Fragment = DataLen Mod ChunkSize    'ÁãËéÊý¾Ý
    If Fragment > 0 Then            'ÓÐÁãËéÊý¾Ý£¬ÔòÏÈ¶Á¸ÃÊý¾Ý
        ReDim ChunkAry(Fragment - 1)
        ChunkAry = blobColumn.GetChunk(Fragment)
        Put FileNumber, , ChunkAry      'Ð´ÈëÎÄ¼þ
    End If

    ReDim ChunkAry(ChunkSize - 1)             'ÎªÊý¾Ý¿éÖØÐÂ¿ª±Ù¿Õ¼ä
    For lngI = 1 To Chunks                              'Ñ»·¶Á³öËùÓÐ¿é
        ChunkAry = blobColumn.GetChunk(ChunkSize)   'ÔÚÊý¾Ý¿âÖÐÁ¬Ðø¶ÁÊý¾Ý¿é
        Put FileNumber, , ChunkAry()    '½«Êý¾Ý¿éÐ´ÈëÎÄ¼þÖÐ
    Next lngI
    Close FileNumber            '¹Ø±ÕÎÄ¼þ

    ReadbolbToFile = True
    Exit Function
ErrorHandle:
    ReadbolbToFile = False
'    MsgBox Err.Description, vbCritical, "¶ÁÍ¼ÏñÊý¾Ý³ö´í!"
End Function三、生成该文件后，你要打印可用相关图像控件，如Kodak Imaging的ImageEdit或LeadTools的RasterView等,打开图像,使用控件相关方法打印就OK了
读取OLE对象的的方法我用了,但是不知道为什么我导出出现乱码,不知你所说的这个程序出现此情况没有
这是我一段OLE对象导出代码,能不能帮我看一下为什么会出现乱码
Const BLOCKSIZE = 4096
Private Sub SaveToFile(ByRef Fld As ADODB.Field, DiskFile As String)
'    '定义数据块数组
'    Dim byteData() As Byte
'    '定义数据块个数
'    Dim NumBlocks As Long
'    Dim FieldLength As Long
'    '定义剩余字节长度
'    Dim LeftOver As Long
'    Dim DesFile As Long
'    Dim i As Long
'    '取得字段中数据实际长度
'    FieldLength = Fld.ActualSize
'    DesFile = FreeFile
'    '打开二进制文件
'    Open DiskFile For Binary Access Write As DesFile
'
'    '得到数据块的个数
'    NumBlocks = FieldLength \ BLOCKSIZE
'    '得到剩余字节数
'    LeftOver = FieldLength Mod BLOCKSIZE
'    ReDim byteData(BLOCKSIZE)
'    For i = 1 To NumBlocks
'        '用GetChunck方法将FLD中二进制数据读出
'        byteData() = Fld.GetChunk(BLOCKSIZE)
'        Put DesFile, , byteData()
'        DoEvents
'    Next i
'    '将剩余数据写入FLD
'    ReDim byteData(LeftOver)
'    byteData() = Fld.GetChunk(LeftOver)
'    Put DesFile, , byteData()
'    Close DesFile
'End Function
    '=======================================================================
  Public Function ReadbolbToFile(blobColumn As ADODB.Field, ByVal FileName As String) As Boolean
    Dim FileNumber      As Integer
    Dim DataLen             As Long
    Dim Chunks              As Long
    Dim ChunkAry()      As Byte '定义数据块
    Dim ChunkSize       As Long
    Dim Fragment        As Long
    Dim lngI                As Long

    On Error GoTo ErrorHandle
    ReadbolbToFile = False
    ChunkSize = 2048
    If blobColumn Is Nothing Then Exit Function

    DataLen = blobColumn.ActualSize

    If DataLen < 8 Then Exit Function

    FileNumber = FreeFile
    Open FileName For Binary Access Write As FileNumber
    Chunks = DataLen \ ChunkSize
    Fragment = DataLen Mod ChunkSize
    If Fragment > 0 Then
        ReDim ChunkAry(Fragment - 1)
        ChunkAry = blobColumn.GetChunk(Fragment)
        Put FileNumber, , ChunkAry
    End If

    ReDim ChunkAry(ChunkSize - 1)
    For lngI = 1 To Chunks
        ChunkAry = blobColumn.GetChunk(ChunkSize)
        Put FileNumber, , ChunkAry()
    Next lngI
    Close FileNumber

    ReadbolbToFile = True
    Exit Function
ErrorHandle:
    ReadbolbToFile = False
End Function
  Private Function GetFileName() As String

    CommonDialog1.CancelError = True
On Error GoTo CancelErr
    CommonDialog1.Filter = "所有文件(*.*)|*.*"
    CommonDialog1.ShowSave
    GetFileName = CommonDialog1.FileName
    Exit Function
CancelErr:
    GetFileName = ""

End Function
Private Sub Save2File()
    '建立一个ADO数据连接
    Dim DataConn As New ADODB.Connection
    Dim DataRec As New ADODB.Recordset
    Dim strSQL As String

'若数据库连接出错，则转向ConnectionERR
On Error GoTo ConnectionERR

    '建立一个连接字串
    '这个连接串可能根据数据库配置的不同而不同
    DataConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\数据库开发实例\temp.mdb;Persist Security Info=False"
    'DataConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\考试系统\database\examine.mdb;Persist Security Info=False"
'    DataConn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;"
'    DataConn.ConnectionString = DataConn.ConnectionString & "Persist Security Info=False;"
'    DataConn.ConnectionString = DataConn.ConnectionString & "Initial Catalog=tempdb;"
'    DataConn.ConnectionString = DataConn.ConnectionString & "Data Source=localhost"
    '建立数据库连接
    DataConn.Open

'若RecordSet建立出错，则转向RecordsetERR
On Error GoTo RecordSetERR
    strSQL = "select * from table1 "
   ' strSQL = "SELECT * FROM 题库 WHERE 岗位='" & Text1.Text & "'"
    DataRec.Open strSQL, DataConn, adOpenDynamic, adLockOptimistic
    If DataRec.EOF Then Exit Sub

On Error GoTo OtherERR
    Call ReadbolbToFile(DataRec.Fields("aa"), Text2.Text)
    'Call ReadbolbToFile(DataRec.Fields("试题"), Text2.Text)
    Exit SubConnectionERR:
    '错误处理程序
    MsgBox "数据库连接错误，" & Err.Description, vbCritical, "出错"
    Exit Sub

RecordSetERR:
    MsgBox "RecordSet生成错误，" & Err.Description, vbCritical, "出错"
    DataConn.Close
    Exit Sub

OtherERR:
    MsgBox "其他错误，" & Err.Description, vbCritical, "出错"

    DataRec.Close
    DataConn.Close
End SubPrivate Sub cmdSave2File_Click()
    Call Save2File
End SubPrivate Sub Command1_Click()
    Text2.Text = GetFileName
End Sub