скрипт генерации пост из домена
Sub generateemails()
Dim countdelimiter As Integer
Dim j, i, k, iCellColEmail As Integer
Dim sCell, sCellEmailText As String
Dim TestArray() As String
Dim ithisrow, imaxrows As Long
Columns("A:A").Select
'âñòàâèì äëÿ íà÷àëà ñòîëáåö ïî êîòîðîìó áóäåì åìàéëû âñòàâëÿòü
Range("A1").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "email1"
imaxrows = 100000
iCellColEmail = 4
For ithisrow = 2 To imaxrows
' Cells(ñòðîêà, ñòîëáåö) çàáåðåì äîìåí
sCellDomenText = Cells(ithisrow, iCellColEmail).Value
'åñëè äîìåí åñòü è ìû íå äîáðàëèñü äî êîíöà ñïèñêà òî äåëàåì
If Len(sCellDomenText) > 0 Then
sCellEmailText = "info|mail|office|sales|zakaz|sale|pr|marketing|shop|buh|hello|service|hr|contact|manager|director|dir|tender|reception|it|zakupki|feedback|clients|priemnaya|adm|admin|ceo|tech|main|direktor|secretar|sekretar|manager1|manager2|manager3|registratura|info1|info2|info3"
'ïîëó÷èì ìàññèâ åìàéëîâ ÷òîáû âñòàâëÿòü â ïåðâûé ñòîëáåö òî ÷òî ïåðåä @
TestArray = Split(sCellEmailText, "|")
For k = LBound(TestArray) To UBound(TestArray)
If Len(TestArray(k)) > 0 Then
If k > 0 Then
'ñêîïèðóåì åå â áóôåð îáìåíà íà÷àëüíóþ ñòðîêó
Rows(ithisrow).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ithisrow = ithisrow + 1
End If
Cells(ithisrow, 1).Value = TestArray(k) & "@" & sCellDomenText
'îáùåå êîëè÷åñòâî ñòðîê áóäåò óâåëè÷èâàòüñÿ
End If
Next
End If
Next
End Sub