MS Access 2010 capture webcam image

[rydalplace]

I am trying to find some vba to allow my app to capture and store a webcam image via a Access form.

This used to work before I updated by pc to Windows 7.



Any help greatly appreciated.

Thanks you

[Dal Jeanis]

Post the code that worked, so we can see what might have broken.

[rydalplace]

I am trying to find some vba to allow my app to capture and store a webcam image via a Access form.

This used to work before I updated by pc to Windows 7.

Any help greatly appreciated.

Thanks you

Private Sub cmdSave_Click()

Dim objFSO As Scripting.FileSystemObject
Dim strTempPicture As String
Dim strNewPicture As String
Dim qdf As DAO.QueryDef

' ensure that a picture has been taken
If ImageControl.Picture = "" Then
MsgBox "No picture has been taken"
Exit Sub
End If

' delete the picture if one already exists
strNewPicture = DLookup("ParamText", "tblGlobalSystemParam", "ParamName = 'PhotoLocation'") & "\" & intPeopleID & ".jpg"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strNewPicture) Then objFSO.DeleteFile strNewPicture, True

' rename the picture and move to the picture share
strTempPicture = DLookup("ParamText", "tblSystemParam", "ParamName = 'TempPicture'") & "\Temp.jpg"
objFSO.CopyFile strTempPicture, strNewPicture, True

' update the contractor's details
Set qdf = CurrentDb.QueryDefs("qryStorePicture")
qdf.SQL = "UPDATE tblPeople SET ThumbnailFile = '" & strNewPicture & "', PhotographDate = '" & Now() & "' WHERE PeopleID = " & intPeopleID
qdf.Execute
qdf.Close

' exit
DoCmd.Close

End Sub

Private Sub cmdTakePicture_Click()

Dim objDeviceInfo As WIA.DeviceInfo
Dim objDevice As WIA.Device
Dim objDeviceManager As WIA.DeviceManager
Dim objItem As WIA.Item
Dim objImage As WIA.ImageFile
Dim intCount As Integer
Dim intLoop As Integer
Dim objFSO As Scripting.FileSystemObject
Dim strTempPicture

' create the temporary store if it doesn't exist
strTempPicture = DLookup("ParamText", "tblSystemParam", "ParamName = 'TempPicture'")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strTempPicture) Then objFSO.CreateFolder (strTempPicture)

' delete previously stored pictures
strTempPicture = strTempPicture & "\Temp.jpg"
If objFSO.FileExists(strTempPicture) Then objFSO.DeleteFile strTempPicture, True

' connect to the camera
Set objDeviceManager = New DeviceManager
Set objDeviceInfo = objDeviceManager.DeviceInfos.Item(1)
Set objDevice = objDeviceInfo.Connect

' delete the buffer
intCount = objDevice.Items.Count
For intLoop = 1 To intCount
objDevice.Items.Remove (1)
Next

' take the picture
VideoControl.Enabled = False
objDevice.ExecuteCommand (wiaCommandTakePicture)
VideoControl.Enabled = True
Set objItem = objDevice.Items(1)
Set objImage = objItem.Transfer(wiaFormatJPEG)
objImage.SaveFile (strTempPicture)
ImageControl.Picture = strTempPicture

End Sub

Private Sub Form_Load()

Dim objDeviceManager As WIA.DeviceManager
Dim objDeviceInfo As WIA.DeviceInfo
Dim rst As DAO.Recordset
Dim strName As String

On Error GoTo NoCamera

ImageControl.Picture = ""
intPeopleID = Me.OpenArgs
DoCmd.Restore

' check if a camera is attached
Set objDeviceManager = New DeviceManager
Set objDeviceInfo = objDeviceManager.DeviceInfos.Item(1)

' get the contractors name
Set rst = CurrentDb.OpenRecordset("SELECT nz(FirstName, '') + ' ' + nz(LastName, '') AS ContractorName FROM tblPeople WHERE PeopleID = " & intPeopleID, dbOpenDynaset, dbSeeChanges)
rst.MoveFirst
strName = rst!ContractorName
rst.Close
Set rst = Nothing

' set the caption
Me.Caption = "Take a Photograph of " & strName

Exit Sub

NoCamera:
MsgBox "No camera is attached to the PC"
DoCmd.Close

End Sub

[Dal Jeanis]

I don't see a definition/Dim statement for VideoControl. That appears to be a MATLAB / Mathworks item. Check to see if you have that reference/addin installed.

If your put

OPTION EXPLICIT

At the top of your code module, then Access will tell you each and every item that is missing or undefined. Start with that.

[RichXB]

Dim objDeviceInfo As WIA.DeviceInfo
Dim objDevice As WIA.Device
Dim objDeviceManager As WIA.DeviceManager
Dim objItem As WIA.Item
Dim objImage As WIA.ImageFile
Dim intCount As Integer
Dim intLoop As Integer
Dim objFSO As Scripting.FileSystemObject
Dim strTempPicture

Hi New to the forum, and was looking for a way to do this under W7 and Access 2013 (just updating the systems here from XP & 2003)
I think your problem is the use of WIA, as the support for this isn't available under windows 7 and has been replaced by WPD

I couldn't get WPD operating under 2003 (part of the reason for the upgrade) so if you find an answer I'd appreciate it as I'm just starting on 2013.

[RichXB]

I couldn't get WPD operating under 2003 (part of the reason for the upgrade) so if you find an answer I'd appreciate it as I'm just starting on 2013.

Ok, just in case there's others out there going around in circles getting nowhere, I'm using a workaround at the moment.

Using Batchloaf's robotEyez.exe (sorry, wordpress site and blocked on this connection so I can't post a link) and a shell execute command I can take a photo.

I'm then using irfanviewportable (from portableapps.com) to convert the resultant bitmap to a jpeg, and referencing that within the database.

Roboteyez and irfanviewportable have been copied to a subdirectory within my database folder called imageprocessing

You'll see I've just commented out the old WIA code. In my system this setup uses an 'image acquisition' form and displays the photo with keep, retake and cancel buttons. The commands below give me a 3 second preview to line up and focus the camera which makes it easier to use. This isn't ideal but works under windows 7.

Private Sub btnTakePicture_Click()Dim PictureCommand As String






'build the image capture command using roboeyez
PictureCommand = Application.CurrentProject.Path & "\ImageProcessing\"
PictureCommand = PictureCommand & "roboteyez.exe " & "/bmp /width 640 /height 480 /delay 3000 /preview "
'MsgBox PictureCommand


Call Shell(PictureCommand, vbNormalFocus)






'now convert and rename as needed




Dim PhotoPath As String
Dim TargetPhotoPath As String
Dim ConvertCommand As String
PhotoPath = MyDocuments() & "\frame.bmp" 'uses the custom mydocuments function to work out where this frame image will have been saved
TargetPhotoPath = Application.CurrentProject.Path & "\Tempimg.jpg"
ConvertCommand = Application.CurrentProject.Path & "\ImageProcessing\"
ConvertCommand = ConvertCommand & "Irfanviewportable.exe " & PhotoPath & " /aspectratio /resample /convert=" & TargetPhotoPath




starttime = Timer
Do Until Timer > starttime + 4
Loop


'MsgBox ConvertCommand
Call Shell(ConvertCommand, vbNormalFocus)


starttime = Timer
Do Until Timer > starttime + 3
Loop


    Me.EmployeeImage.Picture = Application.CurrentProject.Path & "\Tempimg.jpg"
    Form.Repaint




'    Dim WIA_DeviceMgr As Object  'WIA.DeviceManager
'    Dim WIA_Device As Object ' WIA.Device
'    Dim WIA_Item As Object ' WIA.item
'    Dim DeviceID As String
'    Dim CamImg As WIA.ImageFile
'    Dim fs As Object
    
''the next 4 lines deletes the old temp file if it exists
'Set fs = CreateObject("Scripting.FileSystemObject")
'If fs.FileExists(Application.CurrentProject.Path & "\Tempimg.jpg") Then
'    Kill (Application.CurrentProject.Path & "\Tempimg.jpg")
'End If
    
'    Set WIA_DeviceMgr = CreateObject("WIA.DeviceManager")
    
'    If WIA_DeviceMgr.DeviceInfos.Count = 0 Then
'        MsgBox "No Cameras Found, connect a camera. Please note: This feature currently compatible with Windows XP only.", vbOKOnly, "Unable to acquire image"
'        DoCmd.Close acForm, Me.Form.Name
'        Exit Sub
'    End If
        
'    DeviceID = 1 'cboCameras ' Get the selected Device Id from the Combo-Box (column 0)
    
'    On Error GoTo Err_Handler
    
'    Set WIA_Device = WIA_DeviceMgr.DeviceInfos(DeviceID).Connect ' Try to connect to the device
'    If (WIA_Device Is Nothing) Then GoTo Exit_Here


'    Set WIA_Item = WIA_Device.ExecuteCommand(wiaCommandTakePicture) ' Send the 'Take Picture' command
'    'RetrieveItem WIA_Device, WIA_Item
'    Set CamImg = WIA_Item.Transfer
'    CamImg.SaveFile Application.CurrentProject.Path & "\Tempimg.jpg"
'    Me.EmployeeImage.Picture = Application.CurrentProject.Path & "\Tempimg.jpg"
'    Form.Repaint
    
Exit_Here:
'   Set WIA_Device = Nothing
'    Set WIA_Item = Nothing
    Exit Sub


Err_Handler:
    MsgBox Err.Description, vbOKOnly + vbCritical, "Error Taking Picture"
    Resume Exit_Here


End Sub