Guest User

Untitled

a guest
Nov 21st, 2017
494
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.38 KB | None | 0 0
  1. Dim arrNames
  2. Dim cont As Integer
  3.  
  4. cont = 0
  5.  
  6. strPath = ActiveDocument.name
  7. Documents.Open path & "Mails.txt"
  8. strPath2 = ActiveDocument.name
  9.  
  10. With Selection.Find
  11. .Text = ":"
  12. Do While .Execute(Forward:=True, Format:=True) = True
  13.  
  14. Selection.Find.Execute FindText:=(":")
  15. Selection.Expand wdLine
  16.  
  17. arrNames = Split(Selection.Text, ":")
  18.  
  19. Documents(strPath).Activate
  20.  
  21. If cont = 0 Then
  22.  
  23. Call gestOSINT("Pwd")
  24.  
  25. Selection.Find.Execute FindText:=("[Pwd]")
  26.  
  27. ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
  28. 3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
  29. wdAutoFitFixed
  30. With Selection.Tables(1)
  31. If .Style <> "Tabla con cuadrícula" Then
  32. .Style = "Tabla con cuadrícula"
  33. End If
  34. .ApplyStyleHeadingRows = True
  35. .ApplyStyleLastRow = False
  36. .ApplyStyleFirstColumn = True
  37. .ApplyStyleLastColumn = False
  38. .ApplyStyleRowBands = True
  39. .ApplyStyleColumnBands = False
  40. End With
  41. Set tblNew = Selection.Tables(1)
  42.  
  43. tblNew.Style = "Tabla de lista 1 clara - Énfasis 1"
  44. Selection.TypeText Text:="Correo electrónico"
  45. Selection.MoveRight Unit:=wdCell
  46. Selection.TypeText Text:="Tipo de filtrado"
  47. Selection.MoveRight Unit:=wdCell
  48. Selection.TypeText Text:="Plataforma"
  49. End If
  50.  
  51.  
  52.  
  53. Set rowNew = tblNew.Rows.Add
  54.  
  55. rowNew.Cells(1).Range.Text = arrNames(0)
  56. rowNew.Cells(2).Range.Text = arrNames(1)
  57. rowNew.Cells(3).Range.Text = arrNames(2)
  58.  
  59. cont = cont + 1
  60. Documents(strPath2).Activate
  61. Selection.Text = arrNames(0) & vbCrLf
  62.  
  63.  
  64. Selection.MoveDown Unit:=wdLine, Count:=1
  65.  
  66.  
  67. Loop
  68. End With
  69.  
  70.  
  71.  
  72. Documents(strPath2).Activate
  73. ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
  74. Documents(strPath).Activate
  75.  
  76. If cont = 0 Then
  77. pwdMails = False
  78. Else
  79. pwdMails = True
  80. End If
  81.  
  82. mail@mail.com
  83. mail2@mail.com
  84. mail3@mail.com:word1:word2
  85. mail4@mail.com
  86. mail5@mail.com:word3:word4
Add Comment
Please, Sign In to add comment