vba MS Access VBA代码从相机捕获图像并保存
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/43946240/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
MS Access VBA code to capture image from camera and save it
提问by YvetteLee
I want to add a button in my form(MS Access Database), so it can capture image from my camera(laptop) and save it in a specific location (c:\image). I am using windows 10 with office 2010 or office 365.
我想在我的表单（MS Access 数据库）中添加一个按钮，以便它可以从我的相机（笔记本电脑）捕获图像并将其保存在特定位置（c:\image）。我在 Office 2010 或 Office 365 上使用 Windows 10。
Any ideas or help.
任何想法或帮助。
Thank you.
谢谢你。
Ps Update code with WIA:
Ps 使用 WIA 更新代码：
Private Sub Command1_Click()
Dim oWIA_DeviceManager As WIA.DeviceManager
Dim oWIA_Device As WIA.Device
Dim oWIA_ComDlg As WIA.CommonDialog
Dim oImageFile As WIA.ImageFile
Dim i As Long
Set oWIA_DeviceManager = New WIA.DeviceManager
If oWIA_DeviceManager.DeviceInfos.Count > 0 Then
Set oWIA_ComDlg = New WIA.CommonDialog
' Index the Devices property starting here at 1, not 0 .
For i = 1 To oWIA_DeviceManager.DeviceInfos.Count
Set oWIA_Device = oWIA_DeviceManager.DeviceInfos.Item(i).Connect
' Use this to show Acquisition CommonDialog
Set oImageFile = oWIA_ComDlg.ShowAcquireImage
' Use this to show Acquisition Wizard
'Set oImageFile = oWIA_ComDlg.ShowAcquisitionWizard(oWIA_Device)
Next i
Else
MsgBox "No WIA compatible device attached!"
End If
End Sub
With this I manage to open my iPhone camera (usb attach). I need to use my in-build camera of my laptop.
有了这个，我设法打开了我的 iPhone 相机（USB 连接）。我需要使用笔记本电脑的内置摄像头。
Thank you
谢谢
回答by Trevor
This page is probably what you need. http://www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/
此页面可能正是您所需要的。 http://www.developerfusion.com/thread/46191/how-to-capture-picture-using-webcam-in-vb60/
'******************* module code **************
Public Const WS_CHILD As Long = &H40000000
Public Const WS_VISIBLE As Long = &H10000000
Public Const WM_USER As Long = &H400
Public Const WM_CAP_START As Long = WM_USER
Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25
Public Declare 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 Long _
, ByVal nID As Long) As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long _
, ByVal wParam As Long, ByRef lParam As Any) As Long
'************* end of module code ******************
Add the following controls in a form
1. A picture box with name "PicWebCam"
2. A commondialog control with name "CDialog"
3. Add 4 command buttons with name "cmd1","cmd2,"cmd3","cmd4"
then paste the following code
'************************** Code **************
Dim hCap As Long
Private Sub cmd4_Click()
Dim sFileName As String
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
With CDialog
.CancelError = True
.Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
.Filter = "Bitmap Picture(*.bmp)|*.bmp|JPEG Picture(*.jpg)|*.jpg|All Files|*.*"
.ShowSave
sFileName = .FileName
End With
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.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
'**************** Code end ************************
Basically what this is doing is using the windows message pump to send messages to web cam driver, asking it to take a picture. Also, a tip for future self help. You can often get better results by searching VB6, which is almost the exact same thing as VBA. VBA just has a few less functions.
基本上，这是使用 Windows 消息泵向网络摄像头驱动程序发送消息，要求它拍照。此外，为将来的自助提供提示。搜索 VB6 通常可以得到更好的结果，这与 VBA 几乎完全相同。VBA 只是少了一些功能。
If you lack the common dialog control. You can change the code to this
如果您缺少通用对话框控件。你可以把代码改成这样
Private Sub cmd4_Click()
Dim sFileName As String
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
sFileName="C:\PathToNewImageFile.bmp"
Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub
回答by supajason
In the past I have used WIA (Microsoft Windows Image Acquisition) for scanners but it will work with webcams. I'd definitely try it.
过去我曾将 WIA（Microsoft Windows 图像采集）用于扫描仪，但它可以与网络摄像头配合使用。我一定会尝试的。
