'Webcam capture using avicap32 on Access 365 form works on single camera laptops(64-bit), black screen in picture box on 2-camera tablet(32-bit)

After consulting How to use webcam capture on a Microsoft Access form, I have a program where the user presses a button on an Excel form to open an Access form and take before & after photos using built-in webcam then save them to a predetermined folder. This works fine on several laptops including mine but when I try to run it on a tablet with front and back camera, it prompts me to choose between UNICAM Rear and UNICAM Front, which I presume means the code works fine and is connecting to the driver. However, the chosen camera doesn't connect; WM_CAP_DRIVER_CONNECT returns False and I get a black screen in the picture frame.

The tablet is an Acer One 10 running Win10 Home 32-bit and Access 365 Runtime. The I've tested the program using Access Runtime through Command Prompt on my laptop and it worked fine, I've checked that other apps are allowed to access the camera, nothing else is using the camera, tested 0 to 9 for WM_CAP_CONNECT parameters, changed LongPtr back to Long (which by the way still makes it work on win10 Pro 64-bit) and it still doesn't work.

I suspect it's an issue with the tablet and not the code since it's a company tablet and there are two cameras, perhaps I may be missing some permissions to connect to the camera via Access or the code doesn't work with two cameras, but I have no idea where to begin checking these.

I'm currently trying to find a laptop with two cameras to test the program on and in the meantime I'm totally lost and would appreciate suggestions for anything I could try to fix this problem, whether related to the code or not - though I would like to avoid running executables like CommandCam, seeing as I'm using company computers.

This is the part of my Excel code that affects opening Access:

Private Sub mainBtn_Click()
    Dim LCategoryID As Long
    Dim ShellCmd, LPath As String

    Dim wsMain, wsRec As Worksheet

    Set wsMain = Sheets("Main")
    Set wsRec = Sheets("Records")

    mainBtn.Enabled = False

    LPath = ThisWorkbook.Path + "\Database1.accdb"        

    If mainBtn.Caption <> "Record" Then
    If Dir(PathToAccess) <> "" And oApp Is Nothing Then
    ShellCmd = """" & PathToAccess & """ """ & LPath & """"
    VBA.Shell ShellCmd
    If oApp Is Nothing Then Set oApp = GetObject(LPath)
'    Set oApp = CreateObject("Access.Application")
    End If
    Application.Wait (Now + TimeValue("00:00:05"))

    On Error Resume Next
    oApp.OpenCurrentDatabase LPath
    oApp.Visible = False
    On Error GoTo 0
'passing a value through a sub on Access
    oApp.Run "getName", wsMain.Range("F5").Value
    End If
'before photo
    If mainBtn.Caption = "Before Photo" Then
    oApp.DoCmd.openform "Before Photo"
    mainBtn.Caption = "After Photo"
    mainBtn.Enabled = True

This is my code in Access:

Option Compare Database

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

Private Declare Sub sapiSleep Lib "kernel32" _
        Alias "Sleep" _
        (ByVal dwMilliseconds As Long)

Dim hCap As LongPtr
Dim i As Integer
Private Sub cmd4_click()
' take picture
    Dim sFileName, sFileNameSub, dateNow, timeNow As String

    i = i + 1
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)

    dateNow = DateValue(Now)
    timeNow = TimeValue(Now)

    sFileName = CurrentProject.Path + "\dbimages\Before Change " + CStr(Year(dateNow)) + "." + CStr(Month(dateNow)) + "." + CStr(Day(dateNow)) + "  " + CStr(Hour(timeNow)) + "h" + CStr(Minute(timeNow)) + "m" + CStr(Second(timeNow)) + "s.jpg"
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)

    If i = 4 Then
    MsgBox "4 pictures taken. Exiting"
     DoCmd.Close
    Else
    MsgBox "Picture " + CStr(i) + " Taken"
    End If

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()
'    Dim connectAttempts As Integer
    Dim i As Integer
    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)

'        For i = 0 To 9
        If CBool(SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)) = False Then
'            connectAttempts = connectAttempts + 1
            MsgBox "Failed to connect Camera"
        Else
'        Exit For
        End If
'        Next i
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 45, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub
Private Sub Cmd2_Click()
'back to excel
'Dim temp As Long
'temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
    DoCmd.Close
End Sub
Private Sub Form_Close()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
'DoCmd.ShowToolbar "Ribbon", acToolbarYes
End Sub
Private Sub Form_Load()
'DoCmd.ShowToolbar "Ribbon", acToolbarNo
i = 0
cmd1.Caption = "Start Cam"
cmd2.Caption = "Done"
cmd3.Caption = "dummy"
cmd4.Caption = "Tak&e Picture"
    DoCmd.RunCommand acCmdAppMinimize
    DoCmd.Maximize
    If stnName = "Head 1" Or stnName = "Head 2" Then
    Pic1.Picture = CurrentProject.Path + "\images\head_s.jpeg"
    ElseIf stnName = "Marriage Head" Or stnName = "Plus Clip Head" Then
    Pic1.Picture = CurrentProject.Path + "\images\marriage_s.jpeg"
    Else
    Pic1.Picture = CurrentProject.Path + "\images\6pair_s.jpeg"
    End If
    cmd1_click
    On Error Resume Next
    CurrentProject.Application.Visible = True
End Sub

Private Sub sSleep(lngMilliSec As Long)
    If lngMilliSec > 0 Then
        Call sapiSleep(lngMilliSec)
    End If
End Sub

EDIT: Camera app works fine on tablet but I get a black screen in picture box when trying to use it through Access.

EDIT2: Code for WM_CAP_GET_STATUS

Added the following line in main module:

Const WM_CAP_GET_STATUS = WM_CAP_START + 54

Added the following in another module:

Type CAPSTATUS
  uiImageWidth As Long
  uiImageHeight As Long
  fLiveWindow As Long
  fOverlayWindow As Long
  fScale As Long
  ptScroll As POINTAPI
  fUsingDefaultPalette As Long
  fAudioHardware As Long
  fCapFileExists As Long
  dwCurrentVideoFrame As Long
  dwCurrentVideoFramesDropped As Long
  dwCurrentWaveSamples As Long
  dwCurrentTimeElapsedMS As Long
  hPalCurrent As Long
  fCapturingNow As Long
  dwReturn As Long
  wNumVideoAllocated As Long
  wNumAudioAllocated As Long
End Type

New code for starting camera:

Private Sub cmd1_click()
    Dim bool1, bool2, bool3 As Boolean
    Dim o As Integer
    Dim u As Integer
    Dim s As CAPSTATUS

    Open CurrentProject.Path + "\output.txt" For Output As #1

    i = 0 'global variable
    hCap = capCreateCaptureWindow("Take a Camera Shot", ws_child Or ws_visible, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.Form.hwnd, 0)
    sSleep 5000
    If hCap <> 0 Then

        For i = 0 To 9
        Print #1, hCap
        bool1 = CBool(SendMessage(hCap, WM_CAP_DRIVER_CONNECT, i, 0))
        Print #1, bool1
        bool3 = SendMessage(hCap, WM_CAP_GET_STATUS, LenB(s), s)
        Print #1, bool3

            For u = 1 To 4
            If bool1 = True Then
            bool1 = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, i, 0&)
            End If

            o = u * 7
            bool1 = CBool(SendMessage(hCap, WM_CAP_DRIVER_CONNECT, i, 0))
            Print #1, Tab(o); bool1
            bool3 = SendMessage(hCap, WM_CAP_GET_STATUS, LenB(s), s)
            Print #1, Tab(o); bool3
            Next u

        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 45, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)

        Next i
    End If
    Close #1
End Sub


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source