MS 카메라에서 이미지를 캡처하여 저장하는 VBA 코드

Question

내 카메라 (랩톱)에서 이미지를 캡처하고 특정 위치에 저장하기 위해 (MS Access 데이터베이스) 버튼을 내 양식에 추가하고 싶습니다. :\영상). Office 2010 또는 Office 365와 함께 Windows 10을 사용 중입니다.

아이디어 나 도움이 필요합니다.

감사합니다. WIA와

시 업데이트 코드 : 나는 (첨부 USB) 내 아이폰 카메라를 열 관리이와

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 

. 내 노트북의 내장 카메라를 사용해야합니다.

고맙습니다.

Answer 1

이 페이지는 아마도 필요한 것입니다. 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 ************************ 

기본적으로 어떻게이 사진을 촬영하도록 요청, 웹 캠 드라이버에 메시지를 보낼 창 메시지 펌프를 사용하고있다. 또한 미래의 자조를위한 팁. VBA와 거의 똑같은 VB6을 검색하면 더 나은 결과를 얻을 수 있습니다. VBA에는 몇 가지 기능 만 있습니다.

일반적인 대화 상자 컨트롤이없는 경우. 이 코드를 다음과 같이 바꿀 수 있습니다

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 

Answer 2

이전에는 스캐너에 WIA (Microsoft Windows Image Acquisition)를 사용했지만 웹캠에서는 작동합니다. 나는 그것을 분명히 시도 할 것이다.