'#Reference {F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0#C:\WINDOWS\System32\COMDLG32.OCX#Microsoft Common Dialog Control 6.0
'#Reference {00020813-0000-0000-C000-000000000046}#1.4#0#C:\Program Files\Microsoft Office\Office10\EXCEL.EXE#Microsoft Excel 10.0 Object Library
'#Reference {420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\WINDOWS\System32\scrrun.dll#Microsoft Scripting Runtime
Sub Main
Dim xlsFile As Variant
Dim i As Long
Dim img As Image
Dim imgs As Images
Dim r As PropertyRecord
Dim k As Integer

    On Error GoTo catch

    Dim db As Database
    Set db = IMatch.ActiveDatabase
    If db Is Nothing Then
        MsgBox "Please open a database first!"
        Exit Sub
    End If

    Dim iset As Images
    Set iset = db.ActiveSelection
    If iset Is Nothing Then
        MsgBox "Please open a database first!"
        Exit Sub
    End If


    If iset.Count = 0 Then
        MsgBox "Please open a database first!"
        Exit Sub
    End If

    xlsFile = GetFilePath (,"Excel Files|*.xls*", "Choose file", 0)
    If xlsFile = "" Then
        Exit Sub
    End If

    Dim oExcelApp   As Excel.Application
    Dim oWs         As Excel.Worksheet

    Set oExcelApp = CreateObject("EXCEL.APPLICATION")
    oExcelApp.Visible = False
    oExcelApp.Workbooks.Open FileName:=xlsFile, ReadOnly:=True, ignoreReadOnlyRecommended:=True
    Set oWs = oExcelApp.ActiveSheet



    IMatch.WaitDialogOpen "Importing...",0,oWs.Cells.SpecialCells(xlCellTypeLastCell).Row - 1,True

    db.BeginTransaction False

    For i = 2 To oWs.Cells.SpecialCells(xlCellTypeLastCell).Row
        IMatch.WaitDialogSetText "Processing " & oWs.Cells(i, 1).Text
        If oWs.Cells(i, 1).Text <> "" Then
            Set img = iset(oWs.Cells(i, 1).Text)
            If sresult <> "" Then
                sresult = sresult & vbCrLf
            End If
            If Not img Is Nothing Then
                    sResult = sResult & vbCrLf & "** " & oWs.Cells(i, 1).Text & " found in image selection!"
                    Set r = img.Properties
                    k = 2
                    Dim s As String, s2 As String
                    Do Until oWs.Cells(1, k) = ""
                        s = oWs.Cells(1, k)
                        r.Property(s) = oWs.Cells(i, k)
                        k = k + 1
                    Loop
                    r.Update
            Else
                sResult = sResult & vbCrLf & oWs.Cells(i, 1).Text & " not found in image selecion"
            End If
        End If
        If IMatch.WaitDialogIsCanceled Then
            Exit For
        End If
        IMatch.WaitDialogSetPercentage i
    Next i

    db.EndTransaction Not Application.WaitDialogIsCanceled


    Begin Dialog UserDialog 400,203,"Process Results" ' %GRID:10,7,1,1
        Text 20,7,200,14,"Results:",.Text1
        TextBox 30,28,320,126,.txtResult,1
        OKButton 140,168,120,21
    End Dialog

    Dim dlg1 As UserDialog
    If sResult = "" Then
        dlg1.txtResult = "No files."
    Else
        dlg1.txtResult = sResult
    End If
    Dialog dlg1


    GoTo finally

catch:
    MsgBox (Err.Description)

finally:

    oExcelApp.Quit
    Set oExcelApp = Nothing

End Sub