[python] 准时下班系列！Access合集之第2集—三种方案批量上传图片到数据库，你会几种？

• 根据商品名称给商品样图命名，并将所有图片放在一个指定的文件夹
  

• 根据表自动生一个窗体，删除ID、商品名称控件，在窗体上添加一个文本框，一个按钮，用来选择待上传图片的路径
  

Option Compare Database
Option Explicit
'需引用Microsoft Scripting Runtime库
Dim FSO As New FileSystemObject
Private Sub Command17_Click()
  uploadPics
End Sub
'选择图片所在文件夹
Sub uploadPics()
  Dim fd As FileDialog, selectedFile As String
  '选择图片所在文件夹
  Set fd = FileDialog(msoFileDialogFolderPicker)
  If (fd.Show) Then
    '用户点确定按钮
    selectedFile = fd.SelectedItems.Item(1)
    Me.filepath = selectedFile
    updateTablePics (selectedFile)
  Else
    '用户点取消，清空上传图片的路径
    Me.filepath = ""
  End If
End Sub
'将图片上传到窗体控件并保存到表里
Function updateTablePics(selectedFile As String)
  Dim picFile As String, successCount As Integer
  picFile = Dir(selectedFile & "")
  Do While picFile <> ""
    If (picFile Like "*.jpg") Then
      Dim picName As String
      picName = VBA.Replace(picFile, ".jpg", "")
      '出错则跳过这张图
      On Error GoTo ErrorHandler
      
      DoCmd.SearchForRecord acForm, "商品表_保存图片程序包窗体", acFirst, "商品名称='" & picName & "'"
      Me.样品图片.SourceDoc = selectedFile & "" & picFile
      Me.样品图片.OLETypeAllowed = acOLEEmbedded
      '要求控件是可见状态
      Me.样品图片.Action = acOLECreateEmbed
      DoCmd.Save acForm, "商品表_保存图片程序包窗体"
      successCount = successCount + 1
    End If
ErrorHandler:
    picFile = Dir
  Loop
  
  MsgBox "上传成功" & successCount & "张图片"
End Function

Option Compare Database
Option Explicit
'需引用Microsoft Scripting Runtime库
Dim FSO As New FileSystemObject
Sub uploadPics()
  Dim fd As FileDialog, selectedFile As String
  '选择图片所在文件夹
  Set fd = FileDialog(msoFileDialogFolderPicker)
  If (fd.Show) Then
    '用户点确定按钮
    selectedFile = fd.SelectedItems.Item(1)
    updateTablePics (selectedFile)
  End If
End Sub
'将图片数据以二进制流方式保存进表里
Function updateTablePics(selectedFile As String)
  Dim rs As Recordset
  Dim db As Database
  ' 需引用Microsoft ActiveX Data Objects Library库
  Dim adoStream As ADODB.Stream
  Set db = Application.CurrentDb
  Set adoStream = New ADODB.Stream
  
  Set rs = db.OpenRecordset("商品表_保存图片Blob", dbOpenDynaset, dbSeeChanges)
  rs.MoveFirst
  Dim n As Integer
  Do Until rs.EOF
    If FSO.FileExists(selectedFile & "" & rs("商品名称") & ".jpg") Then
       Dim picFile As String, pic As Object
      picFile = selectedFile & "" & rs("商品名称") & ".jpg"
      adoStream.Type = adTypeBinary
      adoStream.Open
      adoStream.LoadFromFile picFile
      
      rs.Edit
      rs("样品图片") = adoStream.Read
      rs.Update
      n = n + 1
      adoStream.Close
    End If
    rs.MoveNext
  Loop
  rs.Clone
  db.Close
  Set adoStream = Nothing
  Set rs = Nothing
  Set db = Nothing
  MsgBox "成功上传" & n & "张图片"
End Function

• 需要对数据库的窗体和控件使用非常熟悉
  
• 会用简单的SQL
  
• 需要查阅API的能力
  
• 需要一定的编码和调试能力