[求助]access数据中取出相片

luyan2006

做得很好，可惜只能生成选定学生的一张相片，哪位高手帮改一改代码，把全部相片生成在“学生相片”的文件夹中？谢谢！

hiyou

*_* 老兄你这个...要手把手教到底吗   我无语了  ORZ  

luyan2006

对不起我真的不会呀!帮人帮到底吧!有空请你吃饭

[此贴子已经被作者于2006-6-26 19:17:35编辑过]

luyan2006

我自己做好了,谢谢hiyou

northwolves

循环记录集

luyan2006

我自己做好了,谢谢hiyou等各位朋友

丸究阵引

能用,但毛病不小！

luyan2006

我试过后也觉得是，

循环记录找不到我健立的文件夹，或提示找不到路径

这句出错

Open strImgFile For Binary As #1
Put #1, , binImg()
Close #1

我用的是XP系统

丸究阵引能不能另外想个办法做一人呢？谢谢

VLE

略作修改

Sub GetPic()

    Dim adoCnn
    Dim adoRs
    Dim strSql As String, strDataSource As String  '<==打开数据库用的字符串变量
    Dim strImgFile As String '<==图像文件名字
    Dim lngImgSize As Long  '<==数据库里的图像字节长度
    Dim binImg() As Byte  '<==用来取图像的二进制文件
   
    Set adoCnn = CreateObject("adodb.connection")
    Set adoRs = CreateObject("adodb.recordset")
   
    strDataSource = "DRIVER={Microsoft Access Driver (*.mdb)};DBQ=" & ThisWorkbook.Path & "\PictureA.mdb"
    adoCnn.Open strDataSource
   
    strSql = "Select * from dataA"
    adoRs.Open strSql, adoCnn
    '以上 ADO一般操作 自已研究
    Do While Not adoRs.EOF  '从头至尾循环
        strImgFile = ThisWorkbook.Path & "\" & adoRs.fields("Name") & ".jpg" '临时图像文件起名为TEMP，喜欢什么随意
        '应该注意的是，你这个数据，其实是JPG，应该起什么后缀，请试过以后再说
       
       
        '下面只演示取第一个记录的图像
        lngImgSize = adoRs.fields("pic").ActualSize
        ReDim binImg(lngImgSize)
        binImg = adoRs.fields("pic").GetChunk(lngImgSize)
        '注意上面这几行的做法
       
        '下面是古老的文件写入工作...
        Open strImgFile For Binary As #1
        Put #1, , binImg()
        Close #1
        adoRs.movenext  '继续下一条记录
    Loop
       
        '....其它的，我不写了，全部扫一遍这种工作，请自已练
    adoRs.Close
    adoCnn.Close

End Sub

hiyou

  授人以鱼（不是渔）X-D

（本来我个人的意思，不是十万火急的情况，自已动手做出来比较好，这种工作真的是手尾啊）

下面是运行的结果：一堆相片（不是代码）

ylMdKDVq.rar (133.25 KB, 下载次数: 276)

2006-6-27 13:22 上传

点击文件名下载附件
[求助]access数据中取出相片

在程序中，相关改动过的代码部分

'_____________________________________________________

。。。。。。

。。。。

adoRs.MoveFirst   '<===从第一行记录开始，准备全部遍历

intCount = 1    '序号，拿来做文件编号

Do While Not adoRs.EOF     '循环，直到文件尾
strname = adoRs.Fields("Name")    '连名字都取出来
strImgFile = ThisWorkbook.Path & "\" & Format(CStr(intcount), "00") & strname & ".jpg" '注意FORMAT是规范两位数的编号

lngImgSize = adoRs.Fields("pic").ActualSize
ReDim binImg(lngImgSize)
binImg = adoRs.Fields("pic").GetChunk(lngImgSize)
'这几行没变过

'文件写入工作...一样，没动
Open strImgFile For Binary As #1
Put #1, , binImg()
Close #1

'....往下一条记录，序号加1
adoRs.MoveNext
intcount = intcount + 1
Loop
'————————————————————————

[此贴子已经被作者于2006-6-27 13:30:00编辑过]