Private Function DocScan1() As Boolean

Dim blnResult As Boolean
Dim d As String
Dim m_tempfile As String
Dim sArr As Variant

m_tempfile = "..."
miVwr.FileName = m_tempfile
miVwr.FitMode = miByTextWidth

        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

Set WIADevice = Nothing
Set WIAProcess = Nothing
Set WIAItem = Nothing
Set WIAProperty = Nothing
Set WIAImage = Nothing
Set wiaDialog = Nothing

Exit Function

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



Private Sub Save_Click()

Dim rst As Recordset
Dim ws As Workspace
Dim dbname As String
Dim dbnew As Database
Dim Img As New WIA.ImageFile
Dim IP As New WIA.ImageProcess
Dim vc As New WIA.Vector
Dim miDoc As MODI.Document

If Me.MiDocView1.FileName <> "" Then
    Set miDoc = Me.MiDocView1.Document
    Me.MiDocView1.FileName = ""
    miDoc.Close
    Set miDoc = Nothing
End If

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
Set Img = Nothing
Set IP = Nothing
Set vc = Nothing
Set rst = Nothing

End Sub

m_tempfile = "\\Srvparus.rs.ru\groups\OTD\Projects-Ryzhov\

Dim miDoc as MODI.Document

Set miDoc = ...

...

miDoc.Close
Set miDoc = Nothing