Img.LoadFile "C:\Documents and Settings\eivchenko\Мои документы\Мои рисунки\MyTestPic.tif"

Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Set vc = CreateObject("WIA.Vector")

Set rst = CurrentDb.OpenRecordset("Doc_Temp")

With rst
.AddNew
![Login] = fOSUserName
![FIO] = DLookup("[FIO]", "Login", "[Login] = '" & fOSUserName & "' ")
![Doc] = Me!Label3
![Klient] = Me!Label4
![Summ] = Me!Label5
![DateDoc] = CDate(Date + Time)
![№] = Me!Label6
![KodVal] = Me!Label7

Img.LoadFile "C:\Documents and Settings\eivchenko\Мои документы\Мои рисунки\MyTestPic.tif"

IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters( 1 ).Properties("FormatID").Value = wiaFormatBMP
IP.Filters( 1 ).Properties("Quality").Value =  5 

Set Img = IP.Apply(Img)
Set vc = Img.FileData
rst("BinData") = vc.BinaryData

.Update
End With
rst.Close

Img.LoadFile Me.Label3

Dim rst As Recordset
Dim ws As Workspace
Dim dbname As String
Dim dbnew As Database
Dim Img, IP, vc

Dim miDoc As MODI.Document

Set miDoc = miVwr.Document
miDoc.Close True
miVwr.Document = ""

Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Set vc = CreateObject("WIA.Vector")

Set rst = CurrentDb.OpenRecordset("Doc_Temp")

With rst
.AddNew
![Login] = fOSUserName
![FIO] = DLookup("[FIO]", "Login", "[Login] = '" & fOSUserName & "' ")
![Doc] = Me!Label3
![Klient] = Me!Label4
![Summ] = Me!Label5
![DateDoc] = CDate(Date + Time)
![№] = Me!Label6
![KodVal] = Me!Label7


Img.LoadFile Me.Label3

IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters( 1 ).Properties("FormatID").Value = wiaFormatBMP
IP.Filters( 1 ).Properties("Quality").Value =  5 

Set Img = IP.Apply(Img)
Set vc = Img.FileData
rst("BinData") = vc.BinaryData

.Update
End With
rst.Close

miDoc.Close True

miVwr.Document.Close

Dim miDoc As MODI.Document

Set miDoc = miVwr.Document
miVwr.Document = ""
miDoc.Close True

miVwr.Document = ""

Img.LoadFile Me.Label3

Option Compare Database
Option Explicit
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Command1_Click()
Dim a As Boolean

a = DocScan1()
MsgBox ("Проверьте правильность указания суммы !!!")
End Sub

Private Function DocScan1() As Boolean

Dim blnResult As Boolean
Dim WIADevice As WIA.Device
Dim WIAProcess As WIA.ImageProcess
Dim WIAItem As WIA.Item
Dim WIAProperty As WIA.Property
Dim WIAImage As WIA.ImageFile
Dim d As String
Dim m_tempfile As String
Dim wiaDialog As New WIA.CommonDialog
Dim sArr As Variant

m_tempfile = "C:\Documents and Settings\eivchenko\Мои документы\Мои рисунки\М0304-3013 от 28.05.07.tif"

        d = txtOCR(m_tempfile)
        Me.Label2 = d
        sArr = Split(d, " ")
        Me.Label3 = m_tempfile
        Me.Label4 = sArr( 19 ) & " " & sArr( 20 )
End Function

Private Function DocScan() As Boolean
On Error GoTo error_DocScan

Dim blnResult As Boolean
Dim WIADevice As WIA.Device
Dim WIAProcess As WIA.ImageProcess
Dim WIAItem As WIA.Item
Dim WIAProperty As WIA.Property
Dim WIAImage As WIA.ImageFile
Dim d As String
Dim m_tempfile As String
Dim wiaDialog As New WIA.CommonDialog
Dim sArr As Variant
Dim ii, i
Dim counter1, counter2
Dim str_val As String
Dim str1 As String
Dim mask_sym As Boolean


m_tempfile = "\\Srvparus.rs.ru\groups\OTD\Projects-Ryzhov\Документооборот_по_валютным_переводам\заявления\заявление" _
& "_" & DatePart("d", Now()) & "_" & DatePart("m", Now()) & DatePart("y", Now()) _
& "_" & DatePart("h", Now()) & "_" _
& DatePart("n", Now()) & "_" & DatePart("s", Now()) & ".tif"


blnResult = True
Set WIADevice = wiaDialog.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, False, True)

If WIADevice.Type = WIA.ScannerDeviceType Then
    Set WIAProcess = CreateObject("Wia.ImageProcess")
    WIAProcess.Filters.Add WIAProcess.FilterInfos("Convert").FilterID
    WIAProcess.Filters(WIAProcess.Filters.Count).Properties("FormatID").Value = _
    WIA.wiaFormatTIFF
    
    For Each WIAItem In WIADevice.Items
        DoEvents

        For Each WIAProperty In WIAItem.Properties
            Select Case WIAProperty.PropertyID
                Case  6146  ' Current Intent
                    WIAProperty.Value =  4 
                Case  6147  ' Horizontal Resolution
                    WIAProperty.Value =  2400  ' 300 DPI
                Case  6148  ' Vertical Resolution
                    WIAProperty.Value =  2400  ' 300 DPI
            End Select
        Next

        Set WIAImage = WIAItem.Transfer
        Set WIAImage = WIAProcess.Apply(WIAImage)
        WIAImage.SaveFile m_tempfile
        d = txtOCR(m_tempfile)
        Me.Label2 = d
        sArr = Split(d, " ")
        Me.Label3 = m_tempfile
        
        Me.Label4 = Null
        Me.Label5 = Null
        Me.Label6 = Null
        
        mask_sym = False
        counter1 =  0 
        counter2 =  0 
        
        For i =  0  To UBound(sArr)
        
        If mask_sym = True And (((sArr(i) Like "###*") = True And (sArr(i) Like "000") = False) Or (sArr(i) Like "*Россия*") = True Or (sArr(i) Like "*М*ск*в*") = True) Then
        counter2 = i -  1 
        Exit For
        End If
        
        If (sArr(i) Like "##########") = True Then
        counter1 = i +  1 
        mask_sym = True
        End If
        
        Next i
        
        str_val = ""
        For i = counter1 To counter2
        If (sArr(i) Like "*щ*тв*") = True Or (sArr(i) Like "*гр*нич*" = True) Or (sArr(i) Like "*тв*енн*" = True) Then
        str1 = "О"
        Else
        If (sArr(i) Like "*акрыт*" = True) Then
        str1 = "З"
        Else
        If (sArr(i) Like "акц*н*рн*" = True) Then
        str1 = "А"
        Else
        If (sArr(i) Like "с" = True) Then
        str1 = ""
        Else
        str1 = sArr(i) + " "
        End If
        End If
        End If
        End If
        
        str_val = str_val + str1
        If (str_val Like "ЗАО") = True Or (str_val Like "ООО") = True Then
        str_val = str_val + " "
        End If
        Next i
        
        For i = counter2 To UBound(sArr)
        If (sArr(i) Like "*#.##") = True Then
        Me.Label5 = sArr(i)
        Exit For
        End If
        
        If (sArr(i) Like "*банк") = True Then
        Exit For
        End If
        Next i
        
        Me.Label4 = str_val
    
    Next
Else
    blnResult = False
    MsgBox "Scanner not found"
End If

DocScan = blnResult
Exit Function

error_DocScan:
DocScan = False
MsgBox "Scanning failed - " & Err.Description
Err.Clear
End Function

Private Function txtOCR(fName As String) As String

Dim miDoc As MODI.Document
Dim miWord As MODI.Word
Dim j As Integer, i As Integer
  
  Set miDoc = New MODI.Document
  miDoc.Create fName
  miDoc.Images( 0 ).OCR miLANG_RUSSIAN,  0 ,  0 
  j = miDoc.Images( 0 ).Layout.Words.Count -  1 
  For i =  0  To j
  Set miWord = miDoc.Images( 0 ).Layout.Words(i)
  txtOCR = txtOCR & Space( 1 ) & miWord.Text
  txtOCR = Trim(txtOCR)
  Next
  miVwr.FitMode = miByWidth
  miVwr.Document = miDoc
  Set miWord = Nothing
  Set miDoc = Nothing

End Function

Private Sub Save_Click()

Dim rst As Recordset
Dim ws As Workspace
Dim dbname As String
Dim dbnew As Database
Dim Img, IP, vc


Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")
Set vc = CreateObject("WIA.Vector")

Set rst = CurrentDb.OpenRecordset("Doc_Temp")

With rst
.AddNew
![Login] = fOSUserName
![FIO] = DLookup("[FIO]", "Login", "[Login] = '" & fOSUserName & "' ")
![Doc] = Me!Label3
![Klient] = Me!Label4
![Summ] = Me!Label5
![DateDoc] = CDate(Date + Time)
![№] = Me!Label6
![KodVal] = Me!Label7


Img.LoadFile Me.Label3

IP.Filters.Add IP.FilterInfos("Convert").FilterID
IP.Filters( 1 ).Properties("FormatID").Value = wiaFormatBMP
IP.Filters( 1 ).Properties("Quality").Value =  5 

Set Img = IP.Apply(Img)
Set vc = Img.FileData
rst("BinData") = vc.BinaryData

.Update
End With
rst.Close

End Sub