Vba Excel email küldés több címzettnek (egy levélben)

Vba Excel email küldés több címzettnek (egy levélben)
2017-07-25T13:38:18+02:00
2017-07-25T16:24:57+02:00
2022-12-04T16:50:36+01:00
sascha1978
Sziasztok!

Van egy Excel listában kb. 800 email cím. Úgy szeretnék nekik e-mailt küldeni, hogy egy e-mail 5-10 (ezt én írom be mint paramétert egy cellába) címre megy ki, de mind a 800 címre kimegy. Azaz 80 e-mailem lesz, amiben 10-10 címzett szerepel (ha a 10-et adtam meg a megfelelő cellában).
Hogy lehet ezt megoldani?
Van egy kódom, de arra nem találtam egyszerű megoldást, hogy a címzetthez több címet is beírjon.
Sub LevelSend() Dim Outlook As Object Dim Mail As Object Dim word As Object, editor As Object Dim doc As Object Dim wordpath As String wordpath = Cells(2, 3) With Application .ScreenUpdating = False .EnableEvents = False End With Dim i As Integer i = 2 Set word = CreateObject("Word.Application") Set doc = word.documents.Open(wordpath) doc.Content.Copy doc.Close Do While Cells(i, 1) > "" Set Outlook = CreateObject("Outlook.Application") Set Mail = Outlook.CreateItem(0) With Mail .to = Cells(i, 1) Set editor = .GetInspector.WordEditor editor.Content.Paste .Subject = Cells(1, 3) '.Attachments.Add "C:\Users\Documents\proba.pdf" .Display End With On Error GoTo 0 Set Mail = Nothing Set Outlook = Nothing i = i + 1 Loop With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
Köszi.
Mutasd a teljes hozzászólást!
Nem tudom kipróbálni sajnos, de így:

.CC = cells(i,2) & ";" &  cells(i,3)     stb..

(Ha ugyanabban a sorban, de más oszlopban vannak)

Vagy ha mindenképpen szöveg kell neki (de alapból úgyis az):

.CC = cstr(cells(i,2)) & ";" & cstr( cells(i,3))

Vagy olyat is tehetsz, hogy a küldés előtt egy stringbe összefűzöd egy ciklussal a szöveget, majd a cc-nek átadod.

Pl

dim CC_nek as String dim j as integer for j=1 to 10 'Nyilván addig kell mennie, amennyi van!! 'itt most ugyanabban az oszlopban, de mássorban vannak az adatok, ha fordítva kell, cseréld meg if cells(j,2).text<>""then 'Ezt az if-et azért tettem bele, hogy az utolsó után ne tegyen ";"-t!! if j<>10 then CC_nek &=cells(j,2) &";" else CC_nek &=cells(j,2) end if end if next j


majd innen a további kód:
.to ...bla bla
'itt átadod a stringet a cc-nek
.cc=CC_nek


Nem 100% de gondolatébresztőnek jó lehet!


Ha nem fogadja el a cells(j,2) akármit, akkor kipróbálhatod így is:
cells(j,2).text
Mutasd a teljes hozzászólást!

  • Szia!

    With Mail
    .to = Cells(i, 1)
    .CC = "valki1@email.com;valaki2@email.com"

    ide a többi kód.

    A valakik helyére gondolom a cells(i,2) stb jó lesz.

    Vagy nem erre gondoltál?
    Mutasd a teljes hozzászólást!
  • Valami ilyesmi, csak a valakik helyére nem tudom beírni cellahivatkozással a címeket.
    Mutasd a teljes hozzászólást!
  • Nem tudom kipróbálni sajnos, de így:

    .CC = cells(i,2) & ";" &  cells(i,3)     stb..

    (Ha ugyanabban a sorban, de más oszlopban vannak)

    Vagy ha mindenképpen szöveg kell neki (de alapból úgyis az):

    .CC = cstr(cells(i,2)) & ";" & cstr( cells(i,3))

    Vagy olyat is tehetsz, hogy a küldés előtt egy stringbe összefűzöd egy ciklussal a szöveget, majd a cc-nek átadod.

    Pl

    dim CC_nek as String dim j as integer for j=1 to 10 'Nyilván addig kell mennie, amennyi van!! 'itt most ugyanabban az oszlopban, de mássorban vannak az adatok, ha fordítva kell, cseréld meg if cells(j,2).text<>""then 'Ezt az if-et azért tettem bele, hogy az utolsó után ne tegyen ";"-t!! if j<>10 then CC_nek &=cells(j,2) &";" else CC_nek &=cells(j,2) end if end if next j


    majd innen a további kód:
    .to ...bla bla
    'itt átadod a stringet a cc-nek
    .cc=CC_nek


    Nem 100% de gondolatébresztőnek jó lehet!


    Ha nem fogadja el a cells(j,2) akármit, akkor kipróbálhatod így is:
    cells(j,2).text
    Mutasd a teljes hozzászólást!
  • Kivettem az If-eket a for ciklusból mert nagyon belezavarodtam :)
    Jó gondolatébresztő volt, ez alapján sikerült megcsinálnom. Köszönöm.
    Mutasd a teljes hozzászólást!
  • Nincs mit, szívesen!
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd