How to use Webcam capture Library in VBA Access?

Question

I'm developing a little project of an Access database for my hometown nonprofit health mutual. I'm new in database and VBA programming. What I do is I search on Internet, learning and adapting the solutions I find online to my database and still now I'm progressing step by step and I'm very satisfied with that approach.

In my database I have a table that records the members with First Name, Phone Number, Address etc. But there is also a field to store the photo of the member. I managed to create an "Import Photo" button associated with the following code:

Private Sub BtnImportPhoto_Click()
    
    Dim fd As FileDialog
    
    Set fd = Application.FileDialog(msoFileDialogOpen)

    With fd
        .AllowMultiSelect = False
        
        .Filters.Clear
        .Filters.Add "Tous les fichiers", "*.*", 1
        .Filters.Add "Fichiers images", "*.jpg; *.jpeg; *.png", 2
        .Title = "Sélectionnez une photo Adhérent"
        .FilterIndex = 2
        
        If .Show Then
            Me.PhotoFilePath.Value = .SelectedItems.Item(1)
        End If
    
    End With

End Sub

The BtnImportPhoto_Click() event allows end users to browse and select a picture file and store the selected filepath to the control "PhotoFilePath".

I wanted to add a button to capture a photo directly from the attached webcam. I found on this site someone that was asking the same question here:

text

That question was answered thanks to @Erik-A who adapted a VB6 code to VBA Access.

I have 2 problems. if I click the button to initialize the webcam, the device is on but the visualization window remains black until I click the format button to choose YUY2. Is there a way to add to the code a function to set it on YUY2 by default?

I want to make it more simple for the end users so if I can avoid that setting window it would be great.

I modified the following code to remove the "Format webcam" button and merge its associated code to the "cmd1" button to initialize the webcam and choose the settings.

Option Compare Database
Option Explicit

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_FILE_SAVEDIB As Long = WM_CAP_START + 25
Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41

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

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&)
        
        ' Appel de la fenêtre de paramétrage de la webcam
        Call SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
        
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub

Private Sub Form_Load()
    cmd1.Caption = "&Allumer Webcam"
    cmd3.Caption = "&Eteindre Webcam"
    cmd4.Caption = "&Capurer Image"
End Sub

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

My second question: Is there a way to crop the photo to square shape to match the needs of the badge we deliver?

I tried with ChatGPT to help me to add to the code to make the YUY2 setting default so the end user will not need to call the setting windows to choose the right format. But the solution provided is not working. the visualization window remains black. Here is the modified code that supposed to solve the problem:

Option Compare Database
Option Explicit

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_FILE_SAVEDIB As Long = WM_CAP_START + 25
Const WM_CAP_SET_VIDEOFORMAT As Long = WM_CAP_START + 45
Const WM_CAP_SET_VIDEOFORMAT_SIZE As Long = WM_CAP_START + 49

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

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_VIDEOFORMAT_SIZE, 0, 640 + (480 * &H10000))
        Call SendMessage(hCap, WM_CAP_SET_VIDEOFORMAT, 0, &H32595559)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub

Private Sub Form_Load()
    cmd1.Caption = "&Allumer Webcam"
    cmd2.Caption = "&Format Webcam"
    cmd3.Caption = "&Eteindre Webcam"
    cmd4.Caption = "&Capurer Image"
End Sub

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

Thanks in advance.