培训

热门文章

最新文章

联系方式

Access交流网(免费Access交流）

QQ：18449932 

网  址：www.access-cn.com

当前位置：首页 > 培训 > Access培训(VIP)
Access培训(VIP)

access图片文件保存到数据库的通用技巧-Access经典源码剖析

 
Access主题 主题：Access图片文件保存到数据库的通用技巧-高手之路                  听课人数：79人      
Access主讲 主讲：王宇虹                       演讲时间：2014-10-15 15:30 至 2014-10-15 16:30
Access培训内容 讲课内容简介：                   Access培训报名： http://www.office-cn.net/thread-118946-1-1.html
  讲解如何关于图片的操作，包括图片文件的上传，下载，浏览，删除等图片处理的操作。从表设计开始讲解图片的存储方式到展示图片的方法都会一一讲解的通用技巧
 培训优势：使用新版Access2013+思维导图模式+Access源码剖析+在线课堂+PPT课件  培训
 培训目标：让你 听得懂 学得会 记得住 用得上             要求：有一定的Access 或 VBA的基础 
 

 

clip0058

Access图片文件保存到数据库的通用技巧

 

 

application_key 功能描述：

 

  • 展示不同图片文件

  • 通用上传图片文件

  • 通用下载图片文件

  • 删除图片记录

 

application_key  行业应用场景：

  • 人事管理系统

            员工信息头像

  • 仓库，产品管理系统

            产品信息照片

  • 其他图片展示功能

  • 图片保存到表中

            图片保存到共享目录

            图片保存到access数据表中

 

application_key  界面预览：

 

     access数据库

 

 

application_key  源码思维导图（脑图）：

 

     access数据库

 

Access教程视频Access图片文件保存到数据库的通用技巧 -- Access经典源码剖析思维导图在线播放
可直接展开和收缩思维导图中的每个节点来浏览，也可使用下面的放大 缩小 折叠 定位焦点 全页显示 查找关键字等功能
 
 

 

application_key  Access培训笔记：

 

  经典源码剖析系列 图片保存到数据表通用操作 Office中国-王宇虹

1 应用场景

1.1 图片保存

1.2 图片显示

2 图片处理方式

2.1 图片存放在共享目录

2.1.1 服务器

2.1.2 优点

2.1.2.1 不占数据库空间

2.1.2.2 数据库只存储文件 的路径

2.1.3 缺点

2.1.3.1 不利于权限控制

2.2 把图片存放在数据表字段

2.2.1 优点

2.2.1.1 方便控制权限

2.2.1.2 与数据库一起备份

2.2.2 缺点

2.2.2.1 占用数据库的空间

2.2.2.2 先转化文件，速度稍慢一些

 

3 模块 源码剖析

3.1 表设计

3.1.1 文件名称

3.1.2 文件本身（OLE）

3.2 通用函数

3.2.1 字段到文件

3.2.1.1 gf_GetFileFromFld

3.2.2 文件到字段

3.2.2.1 gf_SaveFileToFld

3.2.2.1.1 按指定块大小循环读取文件内容到内存，再写到FLD对象

3.3 上传文件

3.3.1 选择需要上传的文件

3.3.1.1 文件对话框

3.3.1.1.1 With Application.FileDialog(3)

3.3.1.1.2 循环所有选择的文件名

3.3.1.1.2.1 For Each varItem In .SelectedItems

3.3.2 把指定文件保存到数据库字段

3.3.2.1 rs.AddNew                    rs("FFileName") = Mid$(varItem, InStrRev(varItem, "\") + 1) '保存文件名时不保存路径                    strFileName = varItem                    gf_SaveFileToFld rs("FFIleOle"), strFileName                    rs.Update                     Me.lstFile.Requery                    blnOK = True

3.3.2.2 InStrRev

3.3.2.2.1 从后往前寻找

3.3.2.3 gf_SaveFileToFld rs("FFIleOle"), strFileName

3.3.3 刷新列表框

3.3.3.1 Me.lstFile.Requery

3.4 展示文件

3.4.1 通过文件ID，在数据表中找到对应的记录

3.4.1.1 rs.Open "select * from tblFile where FFileId=" & Nz(Me.lstFile.Value, 0)

3.4.2 找到OLE字段

3.4.2.1 rs("FFileOle")

3.4.3 将字段内容保存到临时文件

3.4.3.1 临时目录

3.4.3.1.1 Environ$("Temp")

3.4.3.1.2 C:\Users\admin\AppData\Local\Temp

3.4.3.2 gf_GetFileFromFld(rs("FFileOle"), strTemp)

3.4.4 把图片文件 路径赋给图片控件

3.4.4.1 Me.imgPic.Picture = strTemp

3.5 下载文件

3.5.1 先要选择将要存放的目标路径

3.5.1.1 With Application.FileDialog(2)

3.5.1.2 strNewFile = .SelectedItems(1)

3.5.2 保存OLE字段对象到指定文件中

3.5.2.1 gf_GetFileFromFld rs("FFIleOle"), strNewFile

3.6 删除记录

3.6.1 直接删除指定文件 ID对应的记录

3.6.1.1 "Delete * from tblFile where FFileId=" & Nz(Me.lstFile.Value, 0)

3.6.2 刷新列表框

3.6.2.1 Me.lstFile.Requery

4 功能

4.1 展示文件

4.2 上传文件

4.3 下载文件

4.4 删除记录

 

 

 

application_key  相关链接：

 

1. 直接超值购买：

       点击购买：  Button 

       包含：Access示例完整源码+实现思路与代码讲解高清视频+Access培训课件    绝对低价超值

 

2. 购买前咨询：

    

    在线咨询QQ：1918333016

    企业热线QQ：4008553990 （使用QQ搜索： 搜索服务）

 

application_key  部分源码预览：

 

  access数据库

 

Option Compare Database
Option Explicit
 
'保存文件内容到字段:
''=============================================================================================
''函数名称： gf_SaveFileToFld  (将文件保存到OLE字段)  版本：1.01
''调用示例： gf_SaveFileToFld(rsFld,"c:\test.jpg")
''输入参数： (必需)fld    Object      记录集字段
''           (必需)DiskFile   String  文件路径
''返    回： Boolean 成功为True 失败为 False
''适应版本： 97,2000,XP,2003,2007,2010,compatible
''作    者： 王宇虹   整理：TM_彬,阿航
''关 键 字： OLE FILE 图片
''推荐指数： 3
''难度等级： 4
''适应场合： 提示信息框设置
''说    明： 提示信息框设置
''=============================================================================================
''GUID： 72179DB9-68A6-4BBD-9609-1782023ABAC9 编码：1223233325 创建：2013/02/26 更新：2013/02/26
''=============================================================================================
 
'Fld ADO字段对象
'DiskFile -- D:\tony\超级经典源码\OLE2Fld\Image\风雨送春归.jpg
 
 
Public Function gf_SaveFileToFld(ByRef fld As Object, DiskFile As String) As Boolean  ' ADODB.Field
 
On Error GoTo ErrorHandle
 
    Const BLOCKSIZE = 4096
    Dim byteData() As Byte '定义数据块数组
    Dim NumBlocks As Long '定义数据块个数
    Dim filelength As Long '标识文件长度
    Dim LeftOver As Long '定义剩余字节长度
    Dim SourceFile As Long '定义自由文件号
    Dim i As Long '定义循环变量
    SourceFile = FreeFile '提供一个尚未使用的文件号
    Open DiskFile For Binary Access Read As SourceFile '打开文件
    filelength = LOF(SourceFile) '得到文件长度
    If filelength = 0 Then '判断文件是否存在
    Close SourceFile
    MsgBox DiskFile & "无 内 容 或 不 存 在 !"
    Else
    NumBlocks = filelength \ BLOCKSIZE '得到数据块的个数
    LeftOver = filelength Mod BLOCKSIZE '得到剩余字节数
  '.................................
 '.................................
    Get SourceFile, , byteData() '读到内存块中
    fld.AppendChunk byteData() '写入FLD
    
    Close SourceFile '关闭源文件
    End If
        gf_SaveFileToFld = True
        Exit Function
    
ErrorHandle:
        gf_SaveFileToFld = False
        gf_MsgBox "写入数据出错!"
    
End Function
 
'保存字段内容到文件:
 
Public Function gf_GetFileFromFld(blobColumn As Object, ByVal filename) As Boolean  ' ADODB.Field
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
        gf_GetFileFromFld = False
        ChunkSize = 2048                    '定义块大小为 2K
        If IsNull(blobColumn) 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    '零碎数据
       '.................................
        '.................................
    
        ReDim ChunkAry(ChunkSize - 1)             '为数据块重新开辟空间
         '.................................
         '.................................
        Exit Function
ErrorHandle:
        gf_GetFileFromFld = False
        gf_MsgBox "读取数据出错!"
End Function
 
 '--------------------------
 
 
Public Function gf_FileToOleFld(strTable As String, strField As String, strFilter As String, objFileName As String) As Boolean
 
'============================================================
'　过程函数名： CommModule.gf_FileToOleFld　类型：Function
'　参数：
'　　　　 strTable (String)　　：准备保存图形数据的表名称
'　　　　 strField (String)　　：准备保存图形数据的字段名称
'　　　　 strFilter (String)　 ：打开表的过滤字符串，用于定位并确保被打开的表的数据的唯一性
'　　　　 objFileName (String) ：准备输入到表里边的图象文件名称
'　返回：如果保存成功，返回True，如果失败，返回False
'-------------------------------------------------------------
'　说明：把图象文件的数据保存到表里边
'-------------------------------------------------------------
'　修订历史：
'=============================================================
Dim recset  As Object 'ADODB.Recordset
Dim FileData() As Byte, FileNo As Long, FileSize As Long, strSql As String
 
    strSql = "Select " & strField & " From " & strTable & " Where " & strFilter & ";"
    
    Set recset = gf_OpenRecordset(strSql, CurrentProject.Connection, 2, 3)
 
    gf_FileToOleFld = True
'    If recset(strField).Type <> DB_OLE Then  'Or Not IsFileName(objFileName)  'recset(strField).Type <> 205 Or Dir(objFileName) = ""
'        gf_FileToOleFld = False         '如果字段不是OLE字段，或者文件不存在，返回错误
'        GoTo End_FileToOleFld
'    End If
    If recset.EOF Then              '如果记录不存在，返回错误
        gf_FileToOleFld = False
        GoTo End_FileToOleFld
    End If
    '.................................
   '.................................
    ReDim FileData(FileSize)            '重新初始化数组
    FileNo = FreeFile                   '获取一个空闲的文件号
    Open objFileName For Binary As #FileNo  '打开文件
    Get #FileNo, , FileData()           '读取文件内容到数组
    Close #FileNo                       '关闭文件
    recset(strField).Value = FileData() '保存数据
    recset.Update                       '更新数据
    Erase FileData                      '释放内存
End_FileToOleFld:
    recset.Close                        '关闭RecordSet
    Set recset = Nothing                '释放内存
End Function
 
Public Function gf_OleFldToFile(strTable As String, strField As String, strFilter As String, strFileName As String) As Boolean
'============================================================
'　过程函数名： CommModule.gf_OleFldToFile 类型：Function
'　参数：
'　　　　 strTable (String)　　：保存图形数据的表名称
'　　　　 strField (String)　　：保存图形数据的字段名称
'　　　　 strFilter (String)　 ：打开表的过滤字符串，用于定位并确保被打开的表的纪录的唯一性
'　　　　 strFileName (String) ：准备保存的图象的文件名称
'　返回：如果保存成功，返回True，如果失败，返回False
'-------------------------------------------------------------
'　说明：把由gf_FileToOleFld函数保存到表中OLE字段的数据还原到文件
'-------------------------------------------------------------
'　修订历史：
'=============================================================
Dim recset     As Object 'ADODB.Recordset
Dim FileData() As Byte, FileNo As Long, FileSize As Long, strSql As String
 
    strSql = "Select " & strField & " From " & strTable & " Where " & strFilter & ";"
    Set recset = gf_OpenRecordset(strSql, CurrentProject.Connection, 2, 3)
 
    gf_OleFldToFile = True
'    If (recset(strField).Type <> DB_OLE) Or (recset(strField).Type <> 205) Then
'        gf_OleFldToFile = False         '如果字段不是OLE字段，返回错误
'        GoTo End_OleFldToFile
'    End If
    If recset.EOF Then              '如果记录不存在，返回错误
        gf_OleFldToFile = False
        GoTo End_OleFldToFile
    End If
    If recset(strField).ActualSize <> 0 Then  ' If IsNull(recset(strField)) = True Then SaveToFile = False: Exit Function
      '.................................
     '.................................
        Close #FileNo
        Erase FileData
    Else
       gf_OleFldToFile = False
        GoTo End_OleFldToFile
    End If
End_OleFldToFile:
    recset.Close
    Set recset = Nothing
End Function
 
 
Option Compare Database
Option Explicit
 
 
 
'===============================================================================
'-函数名称:         gf_GetFileSize
'-功能描述:         获取文件的大小
'-输入参数说明:     参数1:rstrFileName String 文件名
'-返回参数说明:     Long 文件大小
'-使用语法示例:     gf_GetFileSize("C:\test\test.xls")
'-参考:
'-使用注意:
'-相容性:           97,2000,XP,2003 compatible
'-作者:             王宇虹，改进：王宇虹
'-更新历史：        2003-12-26
'===============================================================================
Public Function gf_GetFileSize(rstrFileName As String) As Long
    Dim fsoObj As Object
 
  '.................................
     '.................................
        gf_GetFileSize = fsoObj.GetFile(rstrFileName).Size
    End If
End Function
 
 
 
'使用Scripting.FileSystemObject来判断文件属性的一些函数
 
'===============================================================================
'-函数名称:         gf_IsFileName
'-功能描述:         判断是否文件,且文件是否存在
'-输入参数说明:     参数1:rstrFileName String 文件名
'-返回参数说明:     Boolean True代表文件存在,False不存在
'-使用语法示例:     gf_IsFileName("C:\test\test.xls")
'-参考:
'-使用注意:
'-相容性:           97,2000,XP,2003 compatible
'-作者:             王宇虹，改进：王宇虹
'-更新历史：        2003-12-26
'===============================================================================
Public Function gf_IsFileName(rstrFileName As String) As Boolean
    Dim fsoObj As Object
     '.................................
     '.................................
            gf_IsFileName = False
        End If
    End If
End Function
 
 
'
Private Sub lblDonwloadFile_Click()
    Dim strNewFile As String
    Dim rs As New ADODB.Recordset
    rs.Open "select * from tblFile where FFileId=" & Nz(Me.lstFile.Value, 0), CurrentProject.Connection, adOpenDynamic, adLockOptimistic
 
    
    '下载时通过另存为文件对话框选择另存为路径名
    With Application.FileDialog(2) 'msoFileDialogSaveAs
        '.................................
       '.................................
 
            MsgBox "下载完成。", vbInformation
        End If
    End With
    rs.Close
    Set rs = Nothing
End Sub
 
Private Sub lblUploadFile_Click()
On Error GoTo Err_cmdUpload_Click
 
    Dim varItem As Variant
    Dim blnOK As Boolean
    Dim strTemp As String
    Dim dblSize As Double
    Dim strFileName As String
 
    Dim rs As New ADODB.Recordset
    
   '.................................
    '.................................
        .Filters.Clear
        .Filters.Add "所有文件", "*.*"
        If .Show Then
            '循环所有选择的文件名
            For Each varItem In .SelectedItems
                '.................................
                 '.................................
 
                    Me.lstFile.Requery
                    blnOK = True
                Else
                    MsgBox "最大允许上传文件大小为10M，文件 '" & varItem & "' 的大小超出上限，未被上传。", vbExclamation
                End If
NextFor:    Next
        End If
    End With
    rs.Close
 
    '操作未被取消时才显示提示对话框
    If blnOK Then MsgBox "上传完成。", vbInformation
    
Exit_cmdUpload_Click:
    Exit Sub
    
Err_cmdUpload_Click:
    Select Case Err
    Case 3002
        MsgBox "文件被锁定，无法打开。", vbCritical
        Resume NextFor
    Case 3022
        Me.Undo
        MsgBox "不允许重复上传同一个文件。", vbInformation
    Case Else
        MsgBox "#" & Err & vbCrLf & Err.Description, vbCritical
    End Select
    Resume Exit_cmdUpload_Click
End Sub
 
Private Sub lstFile_AfterUpdate()
On Error GoTo Err_Handle
 
    Dim strTemp As String
 
    Dim rs As New ADODB.Recordset
    
    '.................................
      '.................................
    
        strTemp = Environ$("Temp") & "\" & Nz(Me.lstFile.Column(1))
        If Dir(strTemp) <> "" Then Kill strTemp
     '.................................
      '.................................
        Else
           Me.imgPic.PictureType = 1
           Me.imgPic.Picture = ""
           Me.txtPictureSize = ""
        End If
        
 
    Else
        Me.imgPic.PictureType = 1
        Me.imgPic.Picture = ""
        Me.txtPictureSize = ""
    End If
    
Exit_Handle:
    rs.Close
    Set rs = Nothing
     
    Exit Sub
    
Err_Handle:
    Me.txtPictureSize = ""
    MsgBox "#" & Err & vbCrLf & Err.Description, vbCritical
    Resume Exit_Handle
End Sub
 

 

发布人:zstmtony  
分享到：
点击次数：  更新时间：2018-02-28 11:13:29  【打印此页】  【关闭】
上一条：Access通用TAB键和默认值设置-Access经典源码剖析  下一条：没有了


相关文章

热门文章

热门产品