I\'m designing 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 the user can click t
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:
GetSavePath
function to get the path the user wants to save the file at.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.