0

My wife is an academic and she needs to mark vast numbers of assignments. The system she uses creates a large text file, this file is then searched and marked and contains all student submissions. Plagiarism is a huge issue and I'm looking for a way to compare the text document to a separate .docx file with all the known plagiarism phrases and certain keywords and highlight them. I've got something that is sort of working but the problem is I'm looking for phrases and words but the matches are not necessarily exact. Formatting and spelling may differ between students. I have gone as far as I can with this code and Help would be greatly appreciated. This would cut HOURS out of her marking procedure...

This is what I have so far...but is seems to miss a lot of the stuff I need it ti highlight or that is available in the file containing the search terms..

Sub ComparePhraseList()
Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim i As Integer
Dim oPara As Range


sCheckDoc = "C:\Users\dekle\OneDrive\Desktop\UNISA 2021\Plagiarism\Plagiarism Assignment 3 master.docx"  'Change to the path where the document is located.
   Set docCurrent = Selection.Document
    Set docRef = Documents.Open(sCheckDoc)
    docCurrent.Activate
    Options.DefaultHighlightColorIndex = wdRed

    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Highlight = True
        .Replacement.Text = "^&"
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = True
        .MatchWildcards = False
    End With

    For i = 1 To docRef.Paragraphs.Count
        Set oPara = docRef.Paragraphs(i).Range
        oPara.End = oPara.End - 1
        With Selection.Find
            .Wrap = wdFindContinue
            .Text = oPara.Text
            .Execute Replace:=wdReplaceAll
        End With
    Next i

    docRef.Close
    docCurrent.Activate
    Set docRef = Nothing
    Set docCurrent = Nothing
    Set oPara = Nothing
   
End Sub
2
  • Your code is very inefficient. There is no need to loop through individual paragraphs or use Selection. For some more efficient approaches, see, for example: msofficeforums.com/word-vba/23196-need-help-creating-macro.html, msofficeforums.com/word-vba/…, msofficeforums.com/word-vba/…, msofficeforums.com/word-vba/…. For your purposes, you might need to set 'match case' to false and use 'sounds like'.
    – macropod
    Jun 1, 2021 at 22:41
  • In addition to what macropod wrote, consider setting MatchWholeWord to False. If the text samples in the sCheckDoc are not being found because the student papers have slight variations, consider breaking up the paragraphs in sCheckDoc into multiple fragments - i.e. turn one sCheckDoc paragraph into two or more smaller ones. It is a trade-off: smaller sCheckDoc paragraphs have a better chance of a match, but those matches are less likely to represent plagiarism.
    – MikeOnline
    Jun 5, 2021 at 7:55

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.