Hirdetés
- sziku69: Fűzzük össze a szavakat :)
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- Lalikiraly: Macbook NEO 2
- Meggyi001: Áram nélkül....méltóság nélkül.....
- f(x)=exp(x): A laposföld elmebaj: Vissza a jövőbe!
- gban: Ingyen kellene, de tegnapra
- N€T0X|N: Talaria tuning: meg kéne tudni állni!
- Elektromos rásegítésű kerékpárok
- hcl: GPT diszk kisebbre klónozása
-
LOGOUT
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
- 15" MacBook Air M3 16GB RAM/ 512GB SSD - 27% ÁFA (0424AB)
- -50% Dobozos Új Lenovo ThinkPad X1 gen 10 2-in-1 Ultra 7 268V 32gb ram Inter Arc 140V Gari 2030
- AKCIÓ! AMD Ryzen 9 7950X 16 mag 32 szál processzor garanciával hibátlan működéssel
- Eladó új állapotban levő Redmi Note 11 4/64GB szürke / 12 hónap jótállás
- NVME, M2 NGFF, 2,5" SATA SSD-k vegyes OEM márkák és prémium típusok, sok újszerű. 256GB-1TB
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50