-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
zhari
csendes tag
90%-ban sikerült. Pár módosítással:
B oszlopból szedi a címeket. D-E oszlopokból a csatolmányokat.
Abban tudnátok segíteni, hogy CC-be tegye a C oszlopban szereplő mail címet?Sub email_kuld()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As RangeWith Application
.EnableEvents = False
.ScreenUpdating = False
End WithSet sh = Sheets("lista") 'munkalap neve
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
Set rng = sh.Cells(cell.Row, 1).Range("D1:E1") 'D-E oszlopig a csatolmányok. Bármi lehet.ok
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)With OutMail
.To = cell.Value
.cc = "" 'CC-ket a C oszlopból kellene hivatkozni
.Subject = "teszt tárgya " & cell.Offset(0, -1).Value & " 2013.01.02 riport" ' Tárgyat frissíteni.ok
.Body = "Tisztelt " & cell.Offset(0, -1).Value & "!"For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell.Send 'Or use Display.
End WithSet OutMail = Nothing
End If
Next cellSet OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
MsgBox "E-mailek elküldve."
End Sub
Új hozzászólás Aktív témák
- Autómatricák a legjobb minőségben, több ezer minta! PH tagoknak 30% kedvezmény!
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Vírusirtó, Antivirus VPN kulcsok
- Game Pass Ultimate előfizetések 1 - 25 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN!
- Windows, Office licencek a legolcsóbban, egyenesen a Microsoft-tól - 2990 Ft-tól!