Sub ReadRstPic()
    Dim BtArr() As Byte
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim myPath As String
    Dim myTable As String
    Dim SQL As String
    myPath = ThisWorkbook.Path & "\员工管理.accdb"
    myTable = "员工档案"
    On Error GoTo ErrMsg
    With Sheet1
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myPath
        SQL = "Select * From " & myTable & " Where 员工编号=" & Val(.[g2])
        rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        If rst.EOF Then
            MsgBox .[b4] & " 员工编号不存在，请重新输入", , "员工编号错误"
        Else
            .[b3] = rst("姓名")
            .[d3] = rst("出生日期")
            .[f3] = rst("民族")
            .[b4] = rst("性别")
            .[d4] = rst("职务")
            .[f4] = rst("籍贯")
            .[b5] = rst("学历")
            .[d5] = rst("部门")
            .[f5] = rst("电话")
            .[b6] = rst("简历")
'            If IsNull(rst("照片")) Then
'                .Image1.Visible = False
'                .[g3] = "暂无照片"
'            Else
'                BtArr = rst("照片")
'                .Image1.Visible = True
'                .Image1.AutoSize = False
'                .Image1.PictureSizeMode = fmPictureSizeModeStretch
'                Set .Image1.Picture = ByteToPicture(BtArr)
'                .[g3] = ""
'            End If
            BtArr = rst.Fields("照片")
              Open "d:\头像.jpg" For Binary As #1
              Put #1, , BtArr
            Close #1
            Set .Image1.Picture = LoadPicture("d:\头像.jpg")
        End If
    End With
    Exit Sub
ErrMsg:
    MsgBox Err.Description, , "错误报告"
End Sub

原教程上所示的bytetopicture老是出错“can not covert to picture”,所以还是改用最原始的办法open方式打开