Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Dim arrNames
- Dim cont As Integer
- cont = 0
- strPath = ActiveDocument.name
- Documents.Open path & "Mails.txt"
- strPath2 = ActiveDocument.name
- With Selection.Find
- .Text = ":"
- Do While .Execute(Forward:=True, Format:=True) = True
- Selection.Find.Execute FindText:=(":")
- Selection.Expand wdLine
- arrNames = Split(Selection.Text, ":")
- Documents(strPath).Activate
- If cont = 0 Then
- Call gestOSINT("Pwd")
- Selection.Find.Execute FindText:=("[Pwd]")
- ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
- 3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
- wdAutoFitFixed
- With Selection.Tables(1)
- If .Style <> "Tabla con cuadrícula" Then
- .Style = "Tabla con cuadrícula"
- End If
- .ApplyStyleHeadingRows = True
- .ApplyStyleLastRow = False
- .ApplyStyleFirstColumn = True
- .ApplyStyleLastColumn = False
- .ApplyStyleRowBands = True
- .ApplyStyleColumnBands = False
- End With
- Set tblNew = Selection.Tables(1)
- tblNew.Style = "Tabla de lista 1 clara - Énfasis 1"
- Selection.TypeText Text:="Correo electrónico"
- Selection.MoveRight Unit:=wdCell
- Selection.TypeText Text:="Tipo de filtrado"
- Selection.MoveRight Unit:=wdCell
- Selection.TypeText Text:="Plataforma"
- End If
- Set rowNew = tblNew.Rows.Add
- rowNew.Cells(1).Range.Text = arrNames(0)
- rowNew.Cells(2).Range.Text = arrNames(1)
- rowNew.Cells(3).Range.Text = arrNames(2)
- cont = cont + 1
- Documents(strPath2).Activate
- Selection.Text = arrNames(0) & vbCrLf
- Selection.MoveDown Unit:=wdLine, Count:=1
- Loop
- End With
- Documents(strPath2).Activate
- ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
- Documents(strPath).Activate
- If cont = 0 Then
- pwdMails = False
- Else
- pwdMails = True
- End If
- mail@mail.com
- mail2@mail.com
- mail3@mail.com:word1:word2
- mail4@mail.com
- mail5@mail.com:word3:word4
Add Comment
Please, Sign In to add comment