如何使用Corel VBA快速按内容比较Corel文件而不打开文件

Question

我正在尝试按对象比较文件以查找重复项。 我的文件夹中有2900个文件，我需要检查所有文件。 换句话说，我必须运行2900 * 2900次比较方法，每次比较两个文件时，我都需要打开和关闭其中的1个文件。 是否可以使用Corel文件打开文件？ 还是可以从Corel VBA文件中获取metadata \\ metadata.xml来检查和比较其中的一些参数，例如对象（形状）计数？ 我感到绝望...

我正在使用这个逻辑系统

Private Sub CommandButton1_Click()

    Dim Folder As String
    MousePointer = fmMousePointerHourGlass
    Folder = BrowseForFolderDlg("o:\", "Select Source Folder", GetWindowHandle("ThunderDFrame", Me.Caption))
    tb_inputFolder.text = Folder

End Sub

Private Sub CommandButton2_Click()

    Dim fso As Object
    Dim objFolder As Object
    Dim objFileList As Object
    Dim vFile, vFile1 As Variant
    Dim inputFolder As String, outputFolder As String

    inputFolder = tb_inputFolder.text 'input folder

    If (inputFolder = "") Then
        Exit Sub
    End If


    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(inputFolder)
    Set objFileList = objFolder.Files

    Dim currentFile As String

    Dim dunFiles() As String
    Dim arrLength As Integer
    ReDim Preserve dunFiles(1)
    arrLength = 1
    dunFiles(0) = ""



    For Each vFile In objFileList

        Dim doc As Document, doc1 As Document, buf As String
        Dim fName As String
        fName = (Left(vFile.name, Len(vFile.name) - 4))

        buf = Right(vFile.path, 3)

        If (buf = "cdr" And findArrayElement(dunFiles, arrLength, vFile.name) = -1) Then

            Set doc = OpenDocument(vFile.path) 'document opend

            dunFiles(arrLength - 1) = vFile.name
            ReDim Preserve dunFiles((arrLength + 1))
            arrLength = arrLength + 1


            For Each vFile1 In objFileList
                buf = Right(vFile1.path, 3)

                If (vFile1.name = currentFile Or findArrayElement(dunFiles, arrLength, vFile1.name) <> -1 Or buf <> "cdr") Then
                    GoTo nextElement
                End If

                'Set doc1 = OpenDocument(vFile1.path) 'document opend
                Dim res As Variant


                res = writeFile(doc.FileName + " VS " + vFile1.name + " " + Str(Now), doc.FilePath + "compare.log")

                If (compareDocs(doc, vFile1.path)) Then

                    dunFiles(arrLength - 1) = fName + "_" + vFile1.name
                    ReDim Preserve dunFiles((arrLength + 1))
                    arrLength = arrLength + 1

                    Dim name As String
                    name = vFile.ParentFolder.path + "\" + fName + "_" + vFile1.name
                    Name vFile1.path As name


                    res = writeFile(vFile.ParentFolder.path + "\" + fName + " the same as " + name, doc.FilePath + "rename.log")

                End If

                'doc1.Close
nextElement:

            Next vFile1
            doc.Close

        End If




       ' doc.Close 'close document

    Next vFile

    lb_info.Caption = "Finished! Press exit"

End Sub

Private Function findArrayElement(inputArray() As String, inputLen As Integer, element As String)
    Dim e As String
    Dim i As Integer

    findArrayElement = -1

    For i = 0 To inputLen - 1
        If (inputArray(i) = element) Then
            findArrayElement = i
            Exit Function
        End If
    Next i


End Function

Private Function compareDocs(doc As Document, path2 As String)
    Dim doc1 As Document
    Dim e1 As Shape, e2 As Shape, elements() As String
    Dim sameShapesCount As Integer
    sameShapesCount = 0
    ReDim elements(1) As String
    elements(0) = ""

    Set doc1 = OpenDocument(path2) 'document opend
    compareDocs = False


    lb_info.Caption = "Comapre " + doc.FullFileName + " with " + path2

    For Each e1 In doc.SelectableShapes
        e1.UngroupAll
    Next e1

    For Each e2 In doc1.SelectableShapes
        e2.UngroupAll
    Next e2

    If (doc.SelectableShapes.Count <> doc1.SelectableShapes.Count) Then
        doc1.Close
        Exit Function
    End If


    For Each e1 In doc.SelectableShapes




        'If (findArrayElement(elements, (UBound(elements) + 1), Str(e1.StaticID)) = -1) Then
            'ReDim Preserve elements(UBound(elements) + 1) As String
            'elements(UBound(elements)) = e1.StaticID

            For Each e2 In doc1.SelectableShapes
                If (findArrayElement(elements, (UBound(elements) + 1), "2_" + Str(e2.StaticID)) = -1) Then



                    If (e1.CompareTo(e2, cdrCompareShapeType, cdrCompareEquals)) Then
                        If (e1.CompareTo(e2, cdrCompareFillType, cdrCompareEquals)) Then
                            If (e1.CompareTo(e2, cdrCompareOutline, cdrCompareEquals)) Then
                                If (e1.CompareTo(e2, cdrCompareOutlineColor, cdrCompareEquals)) Then
                                    If (e1.CompareTo(e2, cdrCompareOutlineWidth, cdrCompareEquals)) Then
                                        'If (e1.CompareTo(e2, cdrCompareShapeHeight, cdrCompareEquals)) Then
                                            If (e1.CompareTo(e2, cdrCompareFil, cdrCompareEquals)) Then
                                                'If (e1.CompareTo(e2, cdrCompareShapeWidth, cdrCompareEquals)) Then
                                                    ReDim Preserve elements(UBound(elements) + 1) As String
                                                    elements(UBound(elements)) = "2_" + Str(e2.StaticID)
                                                    sameShapesCount = sameShapesCount + 1
                                                    GoTo nextElement1
                                                'End If
                                            End If
                                        'End If
                                    End If
                                End If
                            End If
                        End If
                    End If

                End If
            Next e2

        'End If
nextElement1:
    Next e1

    If (doc.SelectableShapes.Count = sameShapesCount) Then
        compareDocs = True
    End If

    doc1.Close

End Function


Private Function writeFile(text As String, path As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object


    If Not Dir(path, vbDirectory) = vbNullString Then
        Set oFile = fso.OpenTextFile(path, 8)
    Else
        Set oFile = fso.CreateTextFile(path, 0)
    End If


    oFile.WriteLine text
    oFile.Close

    Set fso = Nothing
    Set oFile = Nothing
End Function

主要问题是“开放过程”可能要持续几分钟，要检查2k corel场，我需要一年

Answer 1

第一步，打开每个文件一次。

遍历您所关心的数据-对象数或其他内容-必须相等。

根据这些数据，构建一个哈希值 -伪随机值，该值将它们各自的信息组合在一起。

建立一个从哈希表映射到一组与哈希表匹配的绘图文件的表。

现在，您只需要比较具有相同哈希值的文件，而不是每对文件。 精心设计的哈希和要填充的数据应将您的冲突率降低到几乎为零。

这样可以使程序加速1000到3000左右。

为确保哈希/冲突正常运行，您的第一遍应该只是哈希并打印出冲突列表。

Answer 2

按文件大小对列表进行排序。 仅比较大小相似的文件。 您可以使用dir生成按大小排序的列表。

您只需要打开每个文件一次。 散列每个文件（可能是按字母顺序排列的对象名称列表）。 存储和排序以及重复是相同的对象。

您可以使用excel（如果一次性关闭），也可以使用记录集（如果需要在代码中完成此操作）。