How to use webcam capture on a Microsoft Access form

问题

I'm currently trying to design a database in Microsoft Access 2013 to store records of faulty parts found in the plant. I'm trying to implement a button on my form where the user can click on it to access their device's camera to attach a picture of the fault in the form. The user would be using Windows 10 on a Dell latitude 5290 two in one (If that helps.)

I tried using a code I found online but it is extremely old and I don't believe would work in this age. Regardless, here is the code-

https://www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/

Any help would be really appreciated. Thank you!

回答1:

I see you've had trouble adjusting the code yourself, so let me walk you through the process of adjusting it for VBA.

First, we're going to create a form that holds the webcam code, and add the required controls to it. The controls are:

4 buttons, called cmd1, cmd2, cmd3, and cmd4, and 1 subform control, called PicWebCam. We're using a subform to replace the PictureBox object, since that's not available in Access.

Since the subform needs to display something, we create a second form in design view, and set record selectors and navigation buttons to No. We add no controls to the form, and make it small enough so it doesn't have scroll bars. Then, we set our subform control's source object to the form we just created.

Then, the code also uses a CommonDialog control to let us choose a file path to save the picture. While that's available with some combinations of Windows + Access, we can't rely on that, so we'll use a FileDialog instead.

To get a file path, we add the following code to our form module:

Function GetSavePath() As String
    Dim f As Object 'FileDialog
    Set f = Application.FileDialog(2) 'msoFileDialogSaveAs
    If f.Show <> 0 Then GetSavePath = f.SelectedItems(1)
End Function

Then, we copy-paste the initial declarations (types and declare function statements), and make 2 adjustments:

Since we're going to place them in the form module, Public needs to be removed for everything that's private by default, and changed to Private for the stuff that isn't.
Since we want to be compatible with 64-bit Access (you said you didn't need to be, but adding it anyway), we want to add the PtrSafe keyword to all external functions, and change the type for all pointers from Long to LongPtr. This code comes before the function we just created.

Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000

Const WM_USER As Long = &H400
Const WM_CAP_START As Long = WM_USER

Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25

Private Declare PtrSafe Function capCreateCaptureWindow _
    Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _
         (ByVal lpszWindowName As String, ByVal dwStyle As Long _
        , ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long _
        , ByVal nHeight As Long, ByVal hwndParent As LongPtr _
        , ByVal nID As Long) As Long

Private Declare PtrSafe Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long _
        , ByVal wParam As Long, ByRef lParam As Any) As Long

Dim hCap As LongPtr

Now, we can copy paste the actual functions, and make 2 changes:

Instead of the common dialog control code, we use the GetSavePath function to get the path the user wants to save the file at.
Instead of PicWebCam.hWnd, we use PicWebCam.Form.hWnd to get the hWnd for the frame we want to fill with the webcam feed.

Private Sub cmd4_Click()
Dim sFileName As String
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
    sFileName = GetSavePath
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub

Private Sub Cmd3_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub


Private Sub Cmd1_Click()
    hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.Form.hWnd, 0)
    If hCap <> 0 Then
        Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub

Private Sub Cmd2_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub


Private Sub Form_Load()
cmd1.Caption = "Start &Cam"
cmd2.Caption = "&Format Cam"
cmd3.Caption = "&Close Cam"
cmd4.Caption = "&Save Image"
End Sub

Finally, since we added event handlers for the Form_Load event, we need to make sure the On Load property of the form is set to [Event Procedure]. The same goes for the On Click property of all command buttons we've added.

And, that's it, we've succesfully migrated the webcam code from VB6 to VBA, and recreated the form that was sparsely described in the link you provided. Credits to most of the code go to the author on that link.

You can temporarily download the result here. Note that I recommend you don't, both for educational purposes, and because you shouldn't trust random strangers on the internet giving you unsigned executables. But it's useful if you encounter an error, so you can check if it might be a webcam compatibility issue, or a mistake.

Note that I haven't made any real functional changes to the original code.

来源：https://stackoverflow.com/questions/56757965/how-to-use-webcam-capture-on-a-microsoft-access-form

标签

excel

database

ms-access

access-vba

webcam