'圖片，也可以作為數據添加到數據庫中'

大家好，我們繼續講解VBA數據庫解決方案，今日講解第43講內容：如何向數據庫中增加圖片。這講的內容我們要把圖片存儲入數據庫中，把圖片作為數據來處理。這講的內容非常適合人事管理及一些圖片必要管理的場合。

我們看下面的數據庫：

現在我們要把備註單元格中作為圖片管理，也就是說要把和對應員工編號的必要的圖片放在F列的"備註"字段中，這個時候該如何處理呢？

我們先打開我們的數據庫：

修改備註的字段為OLE對象，這時我們將利用圖片的控件來裝載圖片。看下面我給出的代碼：

Sub mynzRecords_43() '第43講 將圖片添加到數據庫中的方案

Dim abytPic() As Byte

Dim strPicPath, strPicName, strFldPath As String

Dim strPath, strTable, strSQL, strMsg As String

Dim cnADO, rsADO As Object

Set cnADO = CreateObject("ADODB.Connection")

Set rsADO = CreateObject("ADODB.Recordset")

strPath = ThisWorkbook.Path & "\\mydata2.accdb"

strTable = "員工記錄"

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False

.Title = "選擇圖片文件夾位置"

.InitialFileName = ThisWorkbook.Path & "\\"

.AllowMultiSelect = False

.Show

If .SelectedItems.Count = 0 Then Exit Sub

strFldPath = .SelectedItems(1) & "\\"

End With

cnADO.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath

strSQL = "SELECT * FROM " & strTable

rsADO.Open strSQL, cnADO, 1, 3

Do Until rsADO.EOF

strPicName = rsADO(0)

strPicPath = Dir(strFldPath & strPicName & ".*")

If Len(strPicPath) <> 0 Then

strPicPath = strFldPath & strPicPath

intFn = FreeFile

Open strPicPath For Binary As #intFn

ReDim abytPic(LOF(intFn) - 1)

Get #intFn, , abytPic

Close #intFn

rsADO("備註") = abytPic

rsADO.Update

PicSum = PicSum + 1

End If

rsADO.MoveNext

Loop

MsgBox "共有 " & PicSum & " 張照片存入數據庫"

rsADO.Close

cnADO.Close

Set rsADO = Nothing

Set cnADO = Nothing

End Sub

代碼截圖：

代碼講解：

1 With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False

.Title = "選擇圖片文件夾位置"

.InitialFileName = ThisWorkbook.Path & "\\"

.AllowMultiSelect = False

.Show

If .SelectedItems.Count = 0 Then Exit Sub

strFldPath = .SelectedItems(1) & "\\"

End With

上述代碼獲得要加入數據庫的圖片的路徑。

2 Do Until rsADO.EOF

strPicName = rsADO(0)

strPicPath = Dir(strFldPath & strPicName & ".*")

If Len(strPicPath) <> 0 Then

strPicPath = strFldPath & strPicPath

intFn = FreeFile

Open strPicPath For Binary As #intFn

ReDim abytPic(LOF(intFn) - 1)

Get #intFn, , abytPic

Close #intFn

rsADO("備註") = abytPic

rsADO.Update

PicSum = PicSum + 1

End If

rsADO.MoveNext

Loop

打開數據庫後，我們要往裡面加入圖片內容，用的仍是rsADO.Update方法，有了《VBA代碼解決方案》中有關打開二進制文件的知識和動態數組的知識，這些代碼不是很困難了.圖片是作為一個數組放在數據庫中的。

下面我們看程序的運行：

會首先提示你選擇圖片所在的位置：

最後提示我們圖片已經放到數據庫中了。

今日內容迴向：

1 圖片是如何放到數據庫中的？

2 是否理解動態數組呢？