Reviewed — Likely Benign
55
Risk Score
Reviewed — Likely Benign
This document has suspicious findings, shown below, but human review determined the file is in fact likely legitimate, so the risk score is capped at 55.
Heuristics 9
-
VBA project inside OOXML medium 7 related findings OOXML_VBADocument contains a VBA project — VBA macros present
-
Potential Shell call in VBA critical OLE_VBA_SHELLPotential Shell call in VBAMatched line in script
Shell (NormalTemplate.path & Application.PathSeparator & "WCopyfind.4.1.1.exe") -
WScript.Shell usage critical OLE_VBA_WSCRIPTWScript.Shell usageMatched line in script
currDesk = CreateObject("WScript.Shell").SpecialFolders("Desktop") -
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched line in script
Set RegEx = CreateObject("vbscript.regexp") -
GetObject call high OLE_VBA_GETOBJGetObject callMatched line in script
Public Function GetObject(ByVal JsonObject, ByVal valueName) -
VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXECCompiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
-
Document_Open macro low OLE_VBA_DOCOPENDocument_Open macroMatched line in script
Private Sub Document_Open() -
Environ() call (env variable access) low OLE_VBA_ENVIRONEnviron() call (env variable access)Matched line in script
dict_string_3 = "Statist,Refract,Protect,Program,Process,Pigment,Philipp,Perform,Percept,Neglect,Mutagen,Mineral,Inherit,Implant,Exploit,Environ,Electro,Discuss,Depress,Control,Consult,Connect,Complex,Combust,Collect,Biotech,Automat,Austral,Aliment,Account,Transact,Telecomm,Sediment,Prospect,Linguist,Interact,Forecast,Electron,Aeronaut,Accredit,Transport,Transform,Southeast,Represent,Petrochem,Northwest,Northeast,Implement,Conscious,Broadcast,Astronaut,Architect,Transplant,Complement,Breastf … -
Embedded URL info EMBEDDED_URLOne or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.URL http://merrin5.mdpi.lab/public/tools/duplicate_reference_checker In document text (OOXML body / shared strings)
- http://valmerrin.mdpi.labIn document text (OOXML body / shared strings)
- http://valmerrin.mdpi.lab/validateIn document text (OOXML body / shared strings)
- http://merrin5.mdpi.lab/user/manuscripts/new_htmlIn document text (OOXML body / shared strings)
- http://merrin5.mdpi.lab/public/tools/acs_final_checkIn document text (OOXML body / shared strings)
- http://print.mdpi.lab/In document text (OOXML body / shared strings)
- http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.aspIn document text (OOXML body / shared strings)
- https://github.com/VBA-tools/VBA-JSON/pull/82In document text (OOXML body / shared strings)
- https://github.com/VBA-tools/VBA-UtcConverterIn document text (OOXML body / shared strings)
- https://redmine.mdpi.cn/projects/production-editing/wiki/User_GuideIn document text (OOXML body / shared strings)
- http://merrin5.mdpi.lab/user/feedback/list/5In document text (OOXML body / shared strings)
- http://print.mdpi.lab/�In document text (OOXML body / shared strings)
- http://schemas.microsoft.com/office/word/2010/wordprocessingCanvasIn document text (OOXML body / shared strings)
- http://schemas.openxmlformats.org/markup-compatibility/2006In document text (OOXML body / shared strings)
- http://schemas.openxmlformats.org/officeDocument/2006/relationshipsIn document text (OOXML body / shared strings)
- http://schemas.openxmlformats.org/officeDocument/2006/mathIn document text (OOXML body / shared strings)
- http://schemas.microsoft.com/office/word/2010/wordprocessingDrawingIn document text (OOXML body / shared strings)
- http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawingIn document text (OOXML body / shared strings)
- http://schemas.openxmlformats.org/wordprocessingml/2006/mainIn document text (OOXML body / shared strings)
- http://schemas.microsoft.com/office/word/2010/wordmlIn document text (OOXML body / shared strings)
- http://schemas.microsoft.com/office/word/2010/wordprocessingGroupIn document text (OOXML body / shared strings)
- http://schemas.microsoft.com/office/word/2010/wordprocessingInkIn document text (OOXML body / shared strings)
- http://schemas.microsoft.com/office/word/2006/wordmlIn document text (OOXML body / shared strings)
- http://schemas.microsoft.com/office/word/2010/wordprocessingShapeIn document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/wiki/MDPI_Formatting_Rules#ReferencesIn document text (OOXML body / shared strings)
- http://search.crossref.org/In document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/wiki/Tips_of_Word_Formatting_-_WildcardsIn document text (OOXML body / shared strings)
- http://answers.microsoft.com/en-us/office/forum/office_2010-word/wildcard-find-and-replace-with-track-changes/cd35b7-f539-4d0b-902d-7f977dcf67e5?msgId=0ed1476a-6108-4c94-8265-5cab6716046fIn document text (OOXML body / shared strings)
- https://en.wikipedia.org/wiki/List_of_country_calling_codesIn document text (OOXML body / shared strings)
- https://en.wikipedia.org/wiki/Telephone_numbers_in_ChinaIn document text (OOXML body / shared strings)
- http://creativecommons.org/licenses/by/4.0/In document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/wiki/Tips_of_Word_Formatting_-_Alt+codeIn document text (OOXML body / shared strings)
- https://creativecommons.org/licenses/by/3.0/In document text (OOXML body / shared strings)
- https://creativecommons.org/licenses/by/4.0/In document text (OOXML body / shared strings)
- https://doi.org/In document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/issues/newIn document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/wiki/MDPI_Formatting_RulesIn document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/wiki/User_GuideIn document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/wiki/Tips_of_Word_Formatting_-_ShortcutsIn document text (OOXML body / shared strings)
- http://redmine.mdpi.com/projects/production-editing/wiki/Tips_of_Word_Formatting_-_Reference_re-orderIn document text (OOXML body / shared strings)
- http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspxIn document text (OOXML body / shared strings)
- http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspxIn document text (OOXML body / shared strings)
- http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspxIn document text (OOXML body / shared strings)
- http://support.microsoft.com/kb/269370In document text (OOXML body / shared strings)
- http://www.ietf.org/rfc/rfc4627.txtIn document text (OOXML body / shared strings)
- https://support.microsoft.com/en-us/kb/272138In document text (OOXML body / shared strings)
- http://www.opensource.org/licenses/mit-license.phpIn document text (OOXML body / shared strings)
- http://www.alz.org/what-is-dementia.aspIn document text (OOXML body / shared strings)
- http://www.mdpi.com/authors/referencesIn document text (OOXML body / shared strings)
- https://creativecommons.org/licenses/by-nc-nd/4.0/In document text (OOXML body / shared strings)
+12 more URL(s)
Extracted artifacts 2
Files carved from inside the sample during analysis.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas🔏 SignedVBA project digital signature |
vba-macro | oletools.olevba.extract_macros (decoded VBA source from OOXML) | 1613887 bytes |
SHA-256: a6b26de751e7846d01484f2eb95883207a203786efe84ba2b82b06c506a7b3de |
|||
Preview scriptFirst 1,000 lines of the extracted script
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "0{00020906-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Private WithEvents App As Word.Application
Attribute App.VB_VarHelpID = -1
Private Sub Document_Open()
Set App = Word.Application
End Sub
Private Sub App_DocumentBeforeSave(ByVal doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
Dim a
a = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticWords, IncludeFootnotesAndEndnotes:=True)
End Sub
Attribute VB_Name = "article_metadata"
Attribute VB_Base = "0{03804798-E462-46BE-9DA9-000CFC771535}{9E2AD425-2874-43F1-B1F3-6579D69FFABD}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub abstract_Change()
End Sub
Private Sub submit_metadata_Click()
Word.ActiveDocument.BuiltInDocumentProperties("Author") = authors
Word.ActiveDocument.BuiltInDocumentProperties("Title") = title
Word.ActiveDocument.BuiltInDocumentProperties("Subject") = abstract 'Left(abstract, 254)
Word.ActiveDocument.BuiltInDocumentProperties("Keywords") = keywords
Dim strpdfname As String
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _
wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _
PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
' strpdfname = ActiveDocument.path & "\" & Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1) & ".pdf"
' ActiveDocument.ExportAsFixedFormat OutputFileName:= _
' strpdfname, _
' ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
' wdExportOptimizeForPrint, Range:=wdExportAllDocument, from:=1, To:=1, _
' Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
' CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
' BitmapMissingFonts:=True, UseISO19005_1:=True
'''' below are codes to manipulate Acrobat.
'''' single quotes are genuine codes, double or more quotes are comments
''Set pdapp = CreateObject("AcroExch.App")
'Set pddoc = CreateObject("AcroExch.pddoc")
'
'pddoc.Open (strpdfname)
''pddoc.openavdoc (strpdfname)
'
'pddoc.SetPageMode (2)
'
''====probably use pddoc.setinfo here to write author and keywords data to remove the quotation marks
'' but syntax need to be researched
'
'Set jso = pddoc.getjsobject
'
''msgbox jso.zoomtype.fitw gives fitwidth, but jso.zoomtype.fitw itself gives exception,
''and jso.zoomtype = jso.zoomtype.fitw does not work. maybe because vba mix upper case with lower case?
''consider use shell or command line to execute javascript if necessary? 'jso.layout also not working
'
'a = pddoc.Save(PDSaveIncremental, "")
'pddoc.Close
'
'Dim strPrompt As String, editor_action As Integer
'
'strPrompt = "your pdf file has been generated at " & vbNewLine & strpdfname & vbNewLine & "please open the file and change magnification to fit width"
'editor_action = MsgBox(strPrompt, vbOKCancel, "save as pdf done")
'
'If editor_action = 1 Then
''MsgBox (strpdfname)
''pdapp.Show
'Else
''pdapp.exit
'End If
'
'Set pddoc = Nothing
MsgBox "Your pdf file has been generated at " & vbNewLine & strpdfname & vbNewLine, vbInformation
article_metadata.hide
End Sub
Attribute VB_Name = "doi_pub_date"
Attribute VB_Base = "0{EA1FE076-A8AE-4DDC-83F9-1D09654F8481}{3D9CF592-457F-4F86-877C-12126CA3BBF7}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub submit_button_Click()
Dim sect_number As Integer
For sect_number = 1 To ActiveDocument.Sections.count Step 1
ActiveDocument.Sections(sect_number).Range.Select
' If StrPtr(doi) <> 0 Then 'edit text if user did not click cancel
' selection.Text = doi
' End If
'the above should be commented out once revised
'selection.ClearCharacterAllFormatting
Call liyuan_run.purge_header_footer_content_yuan(sect_number)
Next sect_number
' With Selection
' .Font.Name = "Palatino Linotype"
' .Font.Size = 8
' .Font.Italic = True
' .TypeText ss
' .TypeText doi_pub_date.journal
' .Font.Italic = False
' 'Selection.TypeText " "
' .Font.Bold = True
' .TypeText doi_pub_date.year
' .Font.Bold = False
' .TypeText ", "
' .Font.Italic = True
' .TypeText doi_pub_date.volume
' .Font.Italic = False
' .TypeText ", " & doi_pub_date.articlenumber & "; doi:" & doi & Format(doi_pub_date.articlenumber, "0000") '& Chr(13)
'
'End With
Selection.Collapse
' Selection.ClearFormatting
With Selection.Find
.Text = "Published:"
.MatchWildcards = False
.Forward = True
.Wrap = wdFindStop
.MatchByte = True
.Font.Italic = True
.Replacement.Text = ""
End With
Selection.Find.Execute
If Selection.Find.Found Then
With Selection
.Collapse wdCollapseEnd
.MoveEndUntil (Chr(13))
.Font.Italic = True
.Text = " " & doi_pub_date.pub_date
End With
Else
' MsgBox "I cannot find the line to insert publication date!" & vbCrLf & "Please manually set the publication date.", vbCritical
End If
'ActiveDocument.Paragraphs(1).Alignment = wdAlignParagraphLeft
doi_pub_date.hide
End Sub
Private Sub digits_Change()
'
' digits.Value = Not digits.Value
'
' If digits.Value = True Then
' doi.Text = Left(doi, Len(doi) - 4) & Format(Right(doi, 4), "00000")
' Else
' doi.Text = Left(doi, Len(doi) - 5) & Format(Right(doi, 5), "0000")
' End If
'
End Sub
Attribute VB_Name = "layout_symbols"
Attribute VB_Base = "0{DA1896D4-B328-4FD0-BBC4-6ADB868FF0B8}{28DD904A-9695-4512-97E0-EE89C3D7A1A3}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton1_Click()
Selection.TypeText ChrW(945)
End Sub
Private Sub CommandButton100_Click()
Selection.TypeText ChrW(176)
End Sub
Private Sub CommandButton101_Click()
Selection.TypeText ChrW(177)
End Sub
Private Sub CommandButton102_Click()
Selection.TypeText ChrW(215)
End Sub
Private Sub CommandButton103_Click()
Selection.TypeText ChrW(183)
End Sub
Private Sub CommandButton104_Click()
Selection.TypeText ChrW(8722)
End Sub
Private Sub CommandButton105_Click()
Selection.TypeText ChrW(8211)
End Sub
Private Sub CommandButton106_Click()
Selection.TypeText ChrW(8212)
End Sub
Private Sub CommandButton107_Click()
Selection.TypeText ChrW(197)
End Sub
Private Sub CommandButton15_Click()
Selection.TypeText ChrW(959)
End Sub
Private Sub CommandButton2_Click()
Selection.TypeText ChrW(946)
End Sub
Private Sub CommandButton3_Click()
Selection.TypeText ChrW(947)
End Sub
Private Sub CommandButton4_Click()
Selection.TypeText ChrW(948)
End Sub
Private Sub CommandButton5_Click()
Selection.TypeText ChrW(949)
End Sub
Private Sub CommandButton6_Click()
Selection.TypeText ChrW(950)
End Sub
Private Sub CommandButton7_Click()
Selection.TypeText ChrW(951)
End Sub
Private Sub CommandButton8_Click()
Selection.TypeText ChrW(952)
End Sub
Private Sub CommandButton9_Click()
Selection.TypeText ChrW(953)
End Sub
Private Sub CommandButton10_Click()
Selection.TypeText ChrW(954)
End Sub
Private Sub CommandButton11_Click()
Selection.TypeText ChrW(955)
End Sub
Private Sub CommandButton12_Click()
Selection.TypeText ChrW(956)
End Sub
Private Sub CommandButton13_Click()
Selection.TypeText ChrW(957)
End Sub
Private Sub CommandButton14_Click()
Selection.TypeText ChrW(958)
End Sub
Private Sub CommandButton_Click()
Selection.TypeText ChrW(959)
End Sub
Private Sub CommandButton16_Click()
Selection.TypeText ChrW(960)
End Sub
Private Sub CommandButton17_Click()
Selection.TypeText ChrW(961)
End Sub
Private Sub CommandButton18_Click()
Selection.TypeText ChrW(963)
End Sub
Private Sub CommandButton19_Click()
Selection.TypeText ChrW(964)
End Sub
Private Sub CommandButton20_Click()
Selection.TypeText ChrW(965)
End Sub
Private Sub CommandButton21_Click()
Selection.TypeText ChrW(966)
End Sub
Private Sub CommandButton22_Click()
Selection.TypeText ChrW(967)
End Sub
Private Sub CommandButton23_Click()
Selection.TypeText ChrW(968)
End Sub
Private Sub CommandButton24_Click()
Selection.TypeText ChrW(969)
End Sub
Private Sub CommandButton51_Click()
Selection.TypeText ChrW(913)
End Sub
Private Sub CommandButton52_Click()
Selection.TypeText ChrW(914)
End Sub
Private Sub CommandButton53_Click()
Selection.TypeText ChrW(9)
End Sub
Private Sub CommandButton54_Click()
Selection.TypeText ChrW(916)
End Sub
Private Sub CommandButton55_Click()
Selection.TypeText ChrW(917)
End Sub
Private Sub CommandButton56_Click()
Selection.TypeText ChrW(918)
End Sub
Private Sub CommandButton57_Click()
Selection.TypeText ChrW(919)
End Sub
Private Sub CommandButton58_Click()
Selection.TypeText ChrW(920)
End Sub
Private Sub CommandButton59_Click()
Selection.TypeText ChrW(921)
End Sub
Private Sub CommandButton60_Click()
Selection.TypeText ChrW(922)
End Sub
Private Sub CommandButton61_Click()
Selection.TypeText ChrW(923)
End Sub
Private Sub CommandButton62_Click()
Selection.TypeText ChrW(924)
End Sub
Private Sub CommandButton63_Click()
Selection.TypeText ChrW(925)
End Sub
Private Sub CommandButton64_Click()
Selection.TypeText ChrW(926)
End Sub
Private Sub CommandButton65_Click()
Selection.TypeText ChrW(927)
End Sub
Private Sub CommandButton66_Click()
Selection.TypeText ChrW(928)
End Sub
Private Sub CommandButton67_Click()
Selection.TypeText ChrW(929)
End Sub
Private Sub CommandButton68_Click()
Selection.TypeText ChrW(931)
End Sub
Private Sub CommandButton69_Click()
Selection.TypeText ChrW(932)
End Sub
Private Sub CommandButton70_Click()
Selection.TypeText ChrW(933)
End Sub
Private Sub CommandButton71_Click()
Selection.TypeText ChrW(934)
End Sub
Private Sub CommandButton72_Click()
Selection.TypeText ChrW(935)
End Sub
Private Sub CommandButton73_Click()
Selection.TypeText ChrW(936)
End Sub
Private Sub CommandButton74_Click()
Selection.TypeText ChrW(937)
End Sub
Private Sub CommandButton998_Click()
Dialogs(wdDialogInsertSymbol).Show
End Sub
Private Sub CommandButton999_Click()
Dialogs(wdDialogInsertSymbol).Show
End Sub
Attribute VB_Name = "ref_divide"
Attribute VB_Base = "0{398A194D-C52A-4DED-AED1-A2EA40F8C0DF}{5BB30EBE-0F69-4815-B4E1-1EEECFAD44AE}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub CommandButton2_Click()
Call liyuan_run.tongpeifu
End Sub
Private Sub expand_unit_value_exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(expand_unit_value.Value) Then
Selection.MoveRight UNIT:=wdWord, count:=CInt(expand_unit_value.Value), Extend:=wdExtend
Else
Selection.MoveEndUntil expand_unit_value, 999
Selection.MoveRight wdCharacter, 1, wdExtend
End If
End Sub
Private Sub help_button_Click()
MsgBox "1. Last name end - try BibTex" & vbCrLf & vbCrLf & _
"2. Last name first " & vbCrLf & "- try BibTex if first name is separated from last name with comma" & vbCrLf & _
"- try NCBI if there is no comma. " & vbCrLf & vbCrLf & _
"3. I will work only if full names are *CONSISTENTLY and EXCLUSIVELY* separated by EITHER comma OR semicolon. I will also fail if comma is used to both separate authors and denote first/last names (e.g., something like First, L., Second, L. will get me down). " & vbCrLf & vbCrLf & _
"4. Entry cannot (1) end with last name and (2) have comma separating out first name *at the same time*. " & vbCrLf & _
"Comma within the name implies the last name is listed first." & vbCrLf & vbCrLf & "Alway run ""Accept Changes and Remove Fields"" first before using me. I will raise alerts along the way if I detect lurking mark-ups." & vbCrLf & vbCrLf & _
"If you have no idea why some author names are unrecognized, press ALT+F11 and try take a sneak peak (in ""immediate"" window)." & vbCrLf & vbCrLf & _
"Please, ALWAYS supervise me. I am a machine and make mistakes.", vbInformation, "General Guidelines"
End Sub
Private Sub highlight_button_Click()
Selection.Range.HighlightColorIndex = IIf(Selection.Range.HighlightColorIndex = wdYellow, wdNoHighlight, wdYellow)
End Sub
Private Sub style_sheet_Click()
ActiveDocument.FollowHyperlink "http://redmine.mdpi.com/projects/production-editing/wiki/MDPI_Formatting_Rules#References"
End Sub
Private Sub show_hide_Button_Click()
If show_hide_button.Value = True Then
ref_divide.Height = 50
show_hide_button.Caption = "Show"
Else
ref_divide.Height = 2
show_hide_button.Caption = "Hide"
End If
End Sub
Private Sub UserForm_Initialize()
Call detect_pitfall_ahead
End Sub
Private Sub bibtex_button_Click()
If garbled_text_warning(Selection.Text) <> vbOK Then Exit Sub
Call layout_feifei_liu.sFormatBibtexName
Selection.Collapse IIf(Selection.Next(wdCharacter, 1) = ";", wdCollapseEnd, wdCollapseStart)
Call next_button_Click
End Sub
Private Sub ncbi_button_Click()
If garbled_text_warning(Selection.Text) <> vbOK Then Exit Sub
'Call layout_feifei_liu.ncbiName
Call kr_deck.kr_ncbi
Selection.Collapse IIf(Selection.Next(wdCharacter, 1) = ";", wdCollapseEnd, wdCollapseStart)
Call next_button_Click
End Sub
Private Sub get_sub_match_Click()
Call reset_back_color
If Selection.Next(wdCharacter, 2) = " " And (Selection.Next(wdCharacter, 1) = "," Or Selection.Next(wdCharacter, 1) = ":") Then Selection.Collapse wdCollapseEnd
If InStr(Selection.Text, ": ") + InStr(Selection.Text, ", ") = 0 Then Selection.Collapse wdCollapseEnd
Selection.Collapse wdCollapseStart
With Selection.Find
.Text = "[!^13]@>([:,;.][ ^13])"
.Format = False
.MatchWildcards = True
.Wrap = wdFindStop
.Execute
If .Found Then
Selection.MoveStartWhile (";. ?!:,")
If InStr(LCase(Selection.Text), "in ") = 1 Then Selection.MoveStart wdCharacter, 3
Selection.MoveEnd UNIT:=wdCharacter, count:=-2
'if the selection went over strings like .; and ., then revert back
Dim a As Long, B As Long
a = InStr(Selection.Text, ".;")
B = InStr(Selection.Text, ".,")
If a = 0 Then
If B > 0 Then Selection.MoveEnd wdCharacter, B - Len(Selection.Text)
Else
If B = 0 Then
Selection.MoveEnd wdCharacter, a - Len(Selection.Text)
Else
Selection.MoveEnd wdCharacter, layout_paragraphs.min(a, B) - Len(Selection.Text)
End If
End If
'''
If InStr(Selection.Text, ";") + InStr(Selection.Text, ". ") > 0 Then get_sub_match.BackColor = 255
Call detect_pitfall_ahead
Else
Selection.Collapse wdCollapseEnd
End If
End With
End Sub
Private Sub expand_selection_button_Click()
On Error GoTo err:
With Selection
If .Next(wdCharacter, 1) = ChrW(13) Then
.Next(wdParagraph, 1).Select
.Collapse wdCollapseStart
Else
.MoveEnd wdCharacter, 1
End If
While .Next(wdCharacter, 1).Previous(wdCharacter, 1).Italic = .Next(wdCharacter, 1).Font.Italic And Asc(.Next(wdCharacter, 1)) <> 13
.MoveEnd wdCharacter, 1
Wend
End With
Exit Sub
err:
Debug.Print "I think you blurted through the end of document.." & err.number & err.Description
End Sub
Private Sub journal_meta_Click()
If Len(Selection.Text) - Len(Replace(Selection.Text, ",", "")) < 2 Then
MsgBox "I don't think this is journal metadata... check again please.", vbCritical, "Something wrong..."
Exit Sub
ElseIf Len(Selection.Text) - Len(Replace(Selection.Text, ",", "")) > 2 Or Not IsNumeric(Mid(Selection.Text, InStr(Selection.Text, ",") - 1, 1)) Then
If MsgBox("This doesn't quite look like journal metadata ... I can try if you insist. Continue? ", vbOKCancel, "Are you sure?") = vbCancel Then Exit Sub
End If
Call layout_feifei_liu.FormatYearVolPage_One
'revise further to adjust when journal name is taken as part
End Sub
Private Sub next_button_Click()
Call reset_back_color
Call Ad_layout_validator.finish_validate_command_ui_change
Selection.Collapse wdCollapseEnd
With Selection.Find
.Text = "[!^13]@>([;.\?\!][ ^13])"
.Format = False
.MatchWildcards = True
.Wrap = wdFindStop
.Execute
If .Found Then
Selection.MoveStartWhile (";. ?!:,")
Selection.MoveEnd UNIT:=wdCharacter, count:=-2
If InStr(Selection.Text, "). ") > 0 Then Selection.MoveEnd wdCharacter, InStr(Selection.Text, "). ") - Len(Selection.Text)
Select Case parse_ref_part
End Select
Call detect_pitfall_ahead
End If
End With
End Sub
Private Sub italic_button_Click()
If Selection.Next(wdCharacter, 1) = "." Then Selection.MoveEndWhile (".")
Selection.Font.Italic = Not Selection.Font.Italic
'Call next_button_Click
If Selection.Font.Italic And Selection.Next(wdCharacter, 2).Font.Italic And Selection.Next(wdCharacter, 1) = " " Then Selection.Next(wdCharacter, 1).Font.Italic = True
End Sub
Function parse_ref_part()
Dim RegEx
Set RegEx = CreateObject("vbscript.regexp")
Dim i As Integer
If Selection.Next(wdCharacter, 1) = "." Then
' refstr = "Wu, H.; Li, X.; Wu, D" & "."
Dim au_names() As String
au_names = Split(Selection.Text & ".", "; ")
With RegEx
.Global = True
.Pattern = "[A-Za-z'" & ChrW(8217) & "\s\-]+,\s([A-Z]\.-?)+(,\sJr\.|,\sI{2,3})?"
'consider common suffix: Jr.,
'does not work for II, III, because the author fetching will ternimate after III; , so the au_names does not end with . and not be processed
End With
'this FOR should be merge with the later IF to have better coding structure
For i = 0 To UBound(au_names) 'Each au_name In au_names
If RegEx.Execute(au_names(i)).count <> 1 Then
If Not (i = 10 And UBound(au_names) = 10 And au_names(i) = "et al.") Then
Debug.Print au_names(i) & "not a valid name"
GoTo not_valid_names
End If
ElseIf RegEx.Execute(au_names(i))(0) <> au_names(i) Then
If Not (i = 10 And UBound(au_names) = 10 And au_names(i) = "et al.") Then
Debug.Print au_names(i) & "not a valid name"
GoTo not_valid_names
End If
End If
Next
'accept only 10 persons and should end with et al. in the 11th
If UBound(au_names) >= 10 Then
If au_names(10) <> "et al." Or UBound(au_names) > 10 Then
Debug.Print "too many authors? (" & UBound(au_names) + 1 & ")"
GoTo not_valid_names
End If
End If
next_button.BackColor = 65280
parse_ref_part = "valid_author_names"
Debug.Print "valid_author_names"
Set sql = Nothing
Set RegEx = Nothing
Exit Function
End If
not_valid_names:
'NCBI names?
'ReDim au_names(0)
au_names_n = Split(Selection.Text, ", ")
With RegEx
.Global = True
.Pattern = "[A-Za-z'" & ChrW(8217) & "\-]+\s[A-Z]+"
End With
For Each au_name In au_names_n
If RegEx.Execute(au_name).count <> 1 Then
GoTo not_valid_ncbi_names
ElseIf RegEx.Execute(au_name)(0) <> au_name Then
GoTo not_valid_ncbi_names
End If
Next
ncbi_button.BackColor = 65280
parse_ref_part = "ncbi_author_names"
Debug.Print "ncbi_author_names"
Set sql = Nothing
Set RegEx = Nothing
Exit Function
not_valid_ncbi_names:
With RegEx
.Global = True
.Pattern = "(19|20)\d{2}\s?,\s?[\d\(\)]+\s?,[\s\d:\-" & ChrW(8211) & "]+"
End With
If Not RegEx.test(Selection.Text) Then GoTo not_valid_journal_meta
journal_meta.BackColor = 65280
journal_meta.Caption = RegEx.Execute(Selection.Text)(0)
parse_ref_part = "journal_meta"
Debug.Print "journal_meta"
Set sql = Nothing
Set RegEx = Nothing
Exit Function
not_valid_journal_meta:
parse_ref_part = "not identified"
Debug.Print "not identified"
Set sql = Nothing
Set RegEx = Nothing
next_button.BackColor = 65535
Set sql = Nothing
Set RegEx = Nothing
End Function
Private Sub reset_back_color()
With ref_divide
.ncbi_button.BackColor = -2147483633
.get_sub_match.BackColor = -2147483633
.next_button.BackColor = -2147483635
.journal_meta.BackColor = -2147483633
.journal_meta.Caption = "YYYY, V, PP" & ChrW(8211) & "PP"
End With
End Sub
Private Sub detect_pitfall_ahead()
Dim Rng As Range
With alert_label
.Caption = ""
.BackColor = -2147483633
If ActiveDocument.TrackRevisions = True Then .Caption = .Caption & "Tracking!" & vbCrLf
Set Rng = Selection.Range
On Error GoTo err
Rng.SetRange Selection.Start, Selection.Next(wdParagraph, 2).End
GoTo back:
err:
Rng.SetRange Selection.Start, ActiveDocument.Range.End
back:
If Rng.Fields.count > 0 Then .Caption = .Caption & "Field!" & vbCrLf
If Rng.Revisions.count > 0 Then .Caption = .Caption & "Revision!" & vbCrLf
If Rng.comments.count > 0 Then .Caption = .Caption & "Comment!"
If .Caption <> "" Then .BackColor = 255
End With
End Sub
Private Function garbled_text_warning(refstr As String)
If InStr(refstr, ";") <> 0 Then
refparts = Split(refstr, ";")
comma_count = Len(refparts(0)) - Len(Replace(refparts(0), ",", ""))
For j = 1 To UBound(refparts)
If comma_count <> Len(refparts(j)) - Len(Replace(refparts(j), ",", "")) Then
ref_divide.alert_label.BackColor = 255
garbled_text_warning = MsgBox(">_<# The text looks somewhat garbled... I may make a mistake. Continue?", vbOKCancel, "@#$%^&|>!~..")
Set ref_parts = Nothing
Exit Function
End If
Next j
Set ref_parts = Nothing
End If
garbled_text_warning = vbOK
End Function
Private Sub CommandButton1_Click()
ActiveDocument.FollowHyperlink "http://search.crossref.org/" & URLEncode(Selection.Text), "", False, True
End Sub
Public Function URLEncode(StringToEncode As String, Optional _
UsePlusRatherThanHexForSpace As Boolean = False) As String
Dim TempAns As String
Dim CurChr As Integer
CurChr = 1
Do Until CurChr - 1 = Len(StringToEncode)
Select Case Asc(Mid(StringToEncode, CurChr, 1))
Case 48 To 57, 65 To 90, 97 To 122
TempAns = TempAns & Mid(StringToEncode, CurChr, 1)
Case 32
If UsePlusRatherThanHexForSpace = True Then
TempAns = TempAns & "+"
Else
TempAns = TempAns & "%" & Hex(32)
End If
Case Else
TempAns = TempAns & "%" & _
Format(Hex(Asc(Mid(StringToEncode, _
CurChr, 1))), "00")
End Select
CurChr = CurChr + 1
Loop
URLEncode = TempAns
End Function
Attribute VB_Name = "layout_document_properties"
Public Sub WriteProp(sPropName As String, sValue As String, _
Optional lType As Long = msoPropertyTypeString)
'In the above declaration, "Optional lType As Long = msoPropertyTypeString" means
'that if the Document Property's Type is Text, we don't need to include the lType argument
'when we call the procedure; but if it's any other Prpperty Type (e.g. date) then we do
Dim bCustom As Boolean
On Error GoTo ErrHandlerWriteProp
'Try to write the value sValue to the custom documentproperties
'If the customdocumentproperty does not exists, an error will occur
'and the code in the errorhandler will run
ActiveDocument.BuiltInDocumentProperties(sPropName).Value = sValue
'Quit this routine
Exit Sub
Proceed:
'We know now that the property is not a builtin documentproperty,
'but a custom documentproperty, so bCustom = True
bCustom = True
Custom:
'Try to set the value for the customproperty sPropName to sValue
'An error will occur if the documentproperty doesn't exist yet
'and the code in the errorhandler will take over
ActiveDocument.CustomDocumentProperties(sPropName).Value = sValue
Exit Sub
AddProp:
'We came here from the errorhandler, so know we know that
'property sPropName is not a built-in property and that there's
'no custom property with this name
'Add it
On Error Resume Next
ActiveDocument.CustomDocumentProperties.Add name:=sPropName, _
LinkToContent:=False, Type:=lType, Value:=sValue
If err Then
'If we still get an error, the value isn't valid for the Property Type
'e,g an invalid date was used
'Debug.Print
MsgBox "The Property " & Chr(34) & _
sPropName & Chr(34) & " couldn't be written, because " & _
Chr(34) & sValue & Chr(34) & _
" is not a valid value for the property type"
End If
Exit Sub
ErrHandlerWriteProp:
Select Case err
Case Else
'Clear the error
err.Clear
'bCustom is a boolean variable, if the code jumps to this
'errorhandler for the first time, the value for bCustom is False
If Not bCustom Then
'Continue with the code after the label Proceed
Resume Proceed
Else
'The errorhandler was executed before because the value for
'the variable bCustom is True, therefor we know that the
'customdocumentproperty did not exist yet, jump to AddProp,
'where the property will be made
Resume AddProp
End If
End Select
End Sub
'We could call the above procedure like this:
Sub test()
'Author is a built-in property
Call WriteProp(sPropName:="Author", sValue:="William Shakespeare")
'Date Updated is a custom document property
Call WriteProp(sPropName:="Date Updated", sValue:="11 Mar 2001", _
lType:=msoPropertyTypeDate)
End Sub
'Reading Document Properties
'The same principle can be used when reading Document Properties:
Function ReadProp(sPropName As String) As Variant
Dim bCustom As Boolean
Dim sValue As String
On Error GoTo ErrHandlerReadProp
'Try the built-in properties first
'An error will occur if the property doesn't exist
sValue = ActiveDocument.BuiltInDocumentProperties(sPropName).Value
ReadProp = sValue
Exit Function
ContinueCustom:
bCustom = True
Custom:
sValue = ActiveDocument.CustomDocumentProperties(sPropName).Value
ReadProp = sValue
Exit Function
ErrHandlerReadProp:
err.Clear
'The boolean bCustom has the value False, if this is the first
'time that the errorhandler is runned
If Not bCustom Then
'Continue to see if the property is a custom documentproperty
Resume ContinueCustom
Else
'The property wasn't found, return an empty string
ReadProp = ""
Exit Function
End If
End Function
'We could call the function like this:
Sub test2()
Dim PropVal As String
PropVal = ReadProp("Author")
MsgBox PropVal
PropVal = ReadProp("Date Updated")
MsgBox PropVal
End Sub
Attribute VB_Name = "layout_feifei_liu"
Option Explicit
Dim i As Integer
Sub feifei_run(ByVal control As IRibbonControl)
Application.ScreenUpdating = False
Select Case control.id
Case "layout_deck_una_magic_quick"
ActiveDocument.TrackRevisions = False ' this is very important - instant revision will immediately alter the text and break subsequent search
With ActiveWindow.View
.ShowRevisionsAndComments = True
.RevisionsView = wdRevisionsViewFinal
End With
If ref_divide.Visible = True Then
ref_divide.hide
Else
Load ref_divide
With ref_divide
.StartUpPosition = 0
.Top = Application.Top + 25
.Left = Application.Left + Application.Width * 0.98 - .Width
.Show
End With
End If
Case "layout_deck_una_magic"
ActiveDocument.TrackRevisions = False ' this is very important - instant revision will immediately alter the text and break subsequent search
With ActiveWindow.View
.ShowRevisionsAndComments = True
.RevisionsView = wdRevisionsViewFinal
…
|
|||
vbaProject_00.bin🔏 SignedVBA project digital signature |
vba-project | OOXML VBA project: word/vbaProject.bin | 3525632 bytes |
SHA-256: 1ded9114bf7943234d6d68cd1ccefd58f3614db5e88b19295a480cbbb4fe3e2d |
|||
Open this report in the interactive analyzer, or submit your own file for analysis.