?
Solved

MS Access - Scanning images

Posted on 2011-04-19
5
Medium Priority
?
596 Views
Last Modified: 2012-08-14
I have a requirement for an MS application to scan images into a table.

I want the userto be open a member form, click on a command button to scan an image into the open record.

Any Ideas?
0
Comment
Question by:Brogrim
5 Comments
 
LVL 18

Assisted Solution

by:lludden
lludden earned 400 total points
ID: 35424128
I use the freeware version of EZTwain (www.eztwain.com)

Here is the module that supports it:
Option Compare Database
Option Explicit

Private sDefaultPath As String
Private fHideUI As Boolean
Private sShellPath As String

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
    hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
    lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
    PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" _
   (ByVal hObject As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
   (ByVal hProcess As Long, lpExitCode As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
   
'EZTwain scanner interface stuff
Private Declare Function TWAIN_IsAvailable Lib "eztw32.dll" () As Long
Private Declare Function TWAIN_SelectImageSource Lib "eztw32.dll" (ByVal hWnd As Long) As Long
Private Declare Function TWAIN_GetSourceList Lib "eztw32.dll" () As Long
Private Declare Function TWAIN_GetNextSourceName Lib "eztw32.dll" (ByRef cSourceName As String) As Long
Private Declare Function TWAIN_OpenSource Lib "eztw32.dll" (ByVal cSourceName As String) As Long
Private Declare Function TWAIN_OpenDefaultSource Lib "eztw32.dll" () As Long
Private Declare Function TWAIN_AcquireNative Lib "eztw32.dll" (ByVal nAppWind As Long, ByVal nPixelTypes As Long) As Long
Private Declare Function TWAIN_WriteNativeToFilename Lib "eztw32.dll" (ByVal nDIB As Long, ByVal cFilename As String) As Long
Private Declare Function TWAIN_FreeNative Lib "eztw32.dll" (ByVal nDIB As Long) As Long
Private Declare Function TWAIN_SetHideUI Lib "eztw32.dll" (ByVal fHide As Long) As Long

Enum Scan_Units
    TWUN_INCHES = 0
    TWUN_CENTIMETERS = 1
    TWUN_PICAS = 2
    TWUN_POINTS = 3
    TWUN_TWIPS = 4
    TWUN_PIXELS = 5
End Enum

Private Declare Function TWAIN_GetCurrentUnits Lib "eztw32.dll" () As Long
Private Declare Function TWAIN_GetBitDepth Lib "eztw32.dll" () As Long
Private Declare Function TWAIN_SetBitDepth Lib "eztw32.dll" (ByVal nBits As Long) As Long
Private Declare Function TWAIN_SetCurrentUnits Lib "eztw32.dll" (ByVal nUnits As Long) As Long

Enum Pixel_Type
    TWPT_BW = 0
    TWPT_GRAY = 1
    TWPT_RGB = 2
    TWPT_PALETTE = 3
    TWPT_CMY = 4
    TWPT_CMYK = 5
End Enum
Private Declare Function TWAIN_GetPixelType Lib "eztw32.dll" () As Long
Private Declare Function TWAIN_SetCurrentPixelType Lib "eztw32.dll" (ByVal nPixType As Long) As Long
Private Declare Function TWAIN_GetCurrentResolution Lib "eztw32.dll" () As Double
Private Declare Function TWAIN_GetYResolution Lib "eztw32.dll" () As Double
Private Declare Function TWAIN_SetCurrentResolution Lib "eztw32.dll" (ByVal dRes As Double) As Long
Private Declare Function TWAIN_SetXResolution Lib "eztw32.dll" (ByVal dxRes As Double) As Long
Private Declare Function TWAIN_SetYResolution Lib "eztw32.dll" (ByVal dyRes As Double) As Long

Enum Scanner_State
    TWAIN_PRESESSION = 1
    TWAIN_SM_LOADED = 2
    TWAIN_SM_OPEN = 3
    TWAIN_SOURCE_OPEN = 4
    TWAIN_SOURCE_ENABLED = 5
    TWAIN_TRANSFER_READY = 6
    TWAIN_TRANSFERRING = 7
End Enum
Private Declare Function TWAIN_State Lib "eztw32.dll" () As Long
Private Declare Function TWAIN_AcquireToClipboard Lib "eztw32.dll" (ByVal hwndApp As Long, ByVal wPixTypes As Long) As Long

Private Declare Function TWAIN_NegotiateXferCount Lib "eztw32.dll" (ByVal Qty As Long) As Long

Private Sub Class_Initialize()
    sShellPath = "C:\Dispatch\"
End Sub

Public Sub ChooseScanner()
    Call TWAIN_SelectImageSource(0)
End Sub

Public Function ScanToFile(Filename As String) As String
Dim lImageHandle As Long
Dim iReply As Integer
Dim sFile As String
Dim sJPGFile As String
Dim lResult As Long

    Call TWAIN_SetHideUI(fHideUI)
    Call OpenSource
    TWAIN_NegotiateXferCount (1)
    sFile = sDefaultPath & Filename & ".bmp"

    lImageHandle = TWAIN_AcquireNative(0, 0)
    iReply = TWAIN_WriteNativeToFilename(lImageHandle, sFile)
    
    If iReply <> 0 Then
        Err.Raise vbObjectError + 701, "cTwain", "Image could not be saved. (" & sFile & ")"
        Exit Function
    End If
    ScanToFile = sFile
End Function

Public Sub ScanToClipboard()
Dim iReply As Integer

    Call TWAIN_SetHideUI(fHideUI)
    Call OpenSource
    
    TWAIN_NegotiateXferCount Qty
    iReply = TWAIN_AcquireToClipboard(0, 0)
    
    If iReply <> 1 Then
        Err.Raise vbObjectError + 708, "cTwain", "Image could not be copied to clipboard."
        Exit Sub
    End If
End Sub

Public Function ConvertToJPG(Filename As String, Optional DeleteOriginal As Boolean = True) As String
Dim sJPGFile As String
Dim sTIFFile As String
Dim RetVal As Long

' convert to JPG
    'sJPGFile = Left(FileName, Len(FileName) - 4) & ".jpg"
    sTIFFile = Left(Filename, Len(Filename) - 4) & ".tiff"

    'RetVal = ExecCmd(sShellPath + "topng.exe " & FileName & " jpeg")
    'RetVal = ExecCmd(sShellPath + "CompressImage.exe " & sJPGFile & " " & sTIFFile)
    RetVal = ExecCmd(sShellPath + "CompressImage.exe " & Filename & " " & sTIFFile)
    'Kill (sJPGFile)
' delete BMP file
    If DeleteOriginal Then
        Kill (Filename)
    End If
    ConvertToJPG = sTIFFile
End Function

Property Let HideUI(Hidden As Boolean)
    fHideUI = Hidden
End Property

Property Get HideUI() As Boolean
    HideUI = fHideUI
End Property

Property Let DefaultPath(Path As String)
    sDefaultPath = Path
End Property

Property Get DefaultPath() As String
    DefaultPath = sDefaultPath
End Property

Property Let Resolution(res As Double)
Dim iReply As Integer
    Call OpenSource
    iReply = TWAIN_SetCurrentResolution(res)
    If iReply = 0 Then
        Err.Raise vbObjectError + 702, "cTwain", "Can't set resolution"
        Exit Property
    End If
End Property

Property Get Resolution() As Double
Dim iReply As Double
    Call OpenSource
    iReply = TWAIN_SetCurrentResolution
    If iReply = 0 Then
        Err.Raise vbObjectError + 703, "cTwain", "Can't get resolution"
        Exit Property
    End If
    Resolution = iReply
End Property

Property Let PixelType(PixelType As Pixel_Type)
Dim iReply As Integer
    Call OpenSource
    iReply = TWAIN_SetCurrentPixelType(PixelType)
    If iReply = 0 Then
        Err.Raise vbObjectError + 704, "cTwain", "Can't set Pixel Type"
        Exit Property
    End If
End Property

Property Get PixelType() As Pixel_Type
Dim iReply As Long
    Call OpenSource
    iReply = TWAIN_GetPixelType
    If iReply = 0 Then
        Err.Raise vbObjectError + 705, "cTwain", "Can't get Pixel Type"
        Exit Property
    End If
    PixelType = iReply
End Property

Property Let CurrentUnits(Units As Scan_Units)
Dim iReply As Integer
    Call OpenSource
    iReply = TWAIN_SetCurrentUnits(Units)
    If iReply = 0 Then
        Err.Raise vbObjectError + 706, "cTwain", "Can't set Current Units"
        Exit Property
    End If
End Property

Property Get CurrentUnits() As Scan_Units
Dim iReply As Long
    Call OpenSource
    iReply = TWAIN_GetCurrentUnits
    If iReply = 0 Then
        Err.Raise vbObjectError + 707, "cTwain", "Can't get Current Units"
        Exit Property
    End If
    CurrentUnits = iReply
End Property


Private Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret&

' Initialize the STARTUPINFO structure:
   start.cb = Len(start)

' Start the shelled application:
   ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
      NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)

' Wait for the shelled application to finish:
      ret& = WaitForSingleObject(proc.hProcess, INFINITE)
      Call GetExitCodeProcess(proc.hProcess, ret&)
      Call CloseHandle(proc.hThread)
      Call CloseHandle(proc.hProcess)
      ExecCmd = ret&
End Function

Private Sub OpenSource()
Dim iReply As Integer

    iReply = TWAIN_OpenDefaultSource()
    If iReply <> 1 Then
        Err.Raise vbObjectError + 700, "cTwain", "Connection with the scanner could not be established."
        Exit Sub
    End If
End Sub

Property Get State() As Scanner_State
    State = TWAIN_State()
End Property

Open in new window

0
 
LVL 26

Expert Comment

by:Nick67
ID: 35425430
I wouldn't scan images into a table.
OLE objects and attachment fields are evil.
Scan things to a folder and save the path of the scan in a table.

You'll be happier in the long run
0
 

Author Comment

by:Brogrim
ID: 35425491
Thanks Nick

Unfortunately I have extract some fields from the table (Images been some of them) and send them to a 3rd party for printing).

I don't think i have any choice but to add them to a table or do I?
0
 
LVL 26

Assisted Solution

by:Nick67
Nick67 earned 400 total points
ID: 35425735
There are always choices!
I have Access reports that successfully embed 120+ digital camera images and print.
The reports have unbound image controls.
In the Format event, you pull the path from the table and set the .picture property to it

    If Nz(Me.Path, "") <> "" Then
        Me.imgPicture1.Picture = Me.Path & "\" & Me.Filename
    End If



0
 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 1200 total points
ID: 35426441
The ability to do this is here:
http://www.ammara.com/

(Input from any TWAIN compliant device , cameras, ...etc)
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access custom database properties are useful for storing miscellaneous bits of information in a format that persists through database closing and reopening.  This article shows how to create and use them.
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Suggested Courses

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question