EXCEL VBA - tömeges email küldés vba segítségével

EXCEL VBA - tömeges email küldés vba segítségével
2018-10-08T08:51:18+02:00
2018-10-08T13:25:59+02:00
2022-10-15T21:35:17+02:00
grondy
Sziasztok,

Az alábbi makrót szeretném használni, de valamiért nem teljesen azt a végeredményt hozza, amelyre szükségem lenne. Excel segítségével szeretnék tömeges emailt kiküldeni tájékoztatás miatt egy adott melléklettel. 
Ha a With Mail részen belül .send-re állítom a makrót, hogy egyből küldje is ki a levelet, akkor valamiért egy üres levelet küld ki (tárgy,csatolmány,feladó és címzett teljesen jó, csak a levél szövege nem). Ha .display, akkor rendben megjelenik a levél, csak a küldés gombra kell rákattintanom. Ha először .display és utána .send, akkor egy ideig jól megy, de ~20-30 db után hibára fut, néha pedig üres üzeneteket küld ki. Vajon mi lehet a problémája? Nem tudok rájönni.

Előre is köszönöm a segítséget és a javaslatokat!

V

Sub Téglalap7_Kattintás() Dim Outlook As Object Dim Mail As Object Dim wd As Object, editor As Object Dim doc As Object Dim iCounter As Integer Dim Dest As Variant Dim SDest As String With Application .ScreenUpdating = False .EnableEvents = False End With Set wd = CreateObject("Word.Application") Set doc = wd.documents.Open("C:\Users\gro\Desktop\level.docx") doc.Content.Copy doc.Close Set Outlook = CreateObject("Outlook.Application") For i = 1 To 1 Set Mail = Outlook.CreateItem(0) With Mail .SentOnBehalfOfName = "asd@asd.hu" .To = Cells(i, 1) Set editor = .GetInspector.WordEditor .Attachments.Add "C:\Users\gro\Desktop\level.pdf" editor.Content.Paste .Subject = "Tájékoztatás" .send End With Next On Error GoTo 0 Set Mail = Nothing Set Outlook = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
Mutasd a teljes hozzászólást!
Ha így sem megy (vagy ha igen, de zavar a display), akkor próbáld meg, hogy előre definiálsz egy string-et, amit átadsz majd a Body-nak. Előtte természetesen a doc-ból kimásolod a szöveget és átadod ennek a string-nek.

dim szoveg as string
szoveg=""

ciklus
szoveg= 'másolás a Word doc-ból'
Debug.print  szoveg.

E-mail rész, ahol .body=szoveg

Az editor-os részt felejtsd el ekkor. A kettőzött doevents-k nem kellenek, de a simák nem ártanak.
Mutasd a teljes hozzászólást!

  • Szia!

    kipróbálni nem tudom de:

    For i = 1 To 1 Doevents Set Mail = Outlook.CreateItem(0) With Mail .SentOnBehalfOfName = "asd@asd.hu" .To = Cells(i, 1) Set editor = .GetInspector.WordEditor .Attachments.Add "C:\Users\gro\Desktop\level.pdf" editor.Content.Paste .Subject = "Tájékoztatás" .send End With 'Ide tegyél egy ilyet: Set Mail= Nothing Set editor= Nothing 'Valamint: doevents Next i 'Itt lemaradt az i, de lehet hogy csak a prog.hu szedte le
    Mutasd a teljes hozzászólást!
  • Valamint:

     Set wd = CreateObject("Word.Application")
     Set doc = wd.documents.Open("C:\Users\gro\Desktop\level.docx")
    .
    .
    .
    Az end sub előtt pedig:

    Set wd=nothing
    Set doc= nothing


    Itt van ez a sor:
    editor.Content.Paste

    Ez után is egy Doevents kell!

    A lényeg, hogy a cikluson belül amit set-el illesztesz, azt töröld is. A cikluson kívüli set-eket pedig az end sub előtt. Ezek fontosak, de lehet nem ez okozza a problémádat. A Doevents pedig megmondja a kódnak, hogy foglalkozzon a többi dologgal, mielőtt tovább futna. Elküldené hamarabb a levelet, mint ahogy abba a vágólapról az infó bekerülne. Egymás után is tehetsz ilyen sorokat bele.
    .
    .
    doevents
    doevensts

    .
    .
    további kódrészlet
    Mutasd a teljes hozzászólást!
  • Szia!

    Köszi!

    Kiegészítettem a javaslataiddal + próbálkoztam több Doevents beszúrni, de nem oldotta meg a problémát. Továbbra is .display-nél rendben van a levél, akár 100 db-nál is, ha annyit kell displayelnie, a .send-nél csak üres levelet küld ki.

    V
    Mutasd a teljes hozzászólást!
  • Azokat mindenképpen tartsd meg, mert sok-sok küldés után szemetelne, nem biztos, hogy hiba mentesen futna sokáig.

    Elvileg mennie kellene. A body formatot állítsd be richtext-re.

    With Mail .SentOnBehalfOfName = "asd@asd.hu" .To = Cells(i, 1) Set editor = .GetInspector.WordEditor .BodyFormat = olFormatRichText doevents .Attachments.Add "C:\Users\gro\Desktop\level.pdf" doevents editor.Content.Paste doevents .Subject = "Tájékoztatás" 'itt mindenképpen meg kell jeleníteni! .display doeveents doevents .send End With
    Mutasd a teljes hozzászólást!
  • Ha így sem megy (vagy ha igen, de zavar a display), akkor próbáld meg, hogy előre definiálsz egy string-et, amit átadsz majd a Body-nak. Előtte természetesen a doc-ból kimásolod a szöveget és átadod ennek a string-nek.

    dim szoveg as string
    szoveg=""

    ciklus
    szoveg= 'másolás a Word doc-ból'
    Debug.print  szoveg.

    E-mail rész, ahol .body=szoveg

    Az editor-os részt felejtsd el ekkor. A kettőzött doevents-k nem kellenek, de a simák nem ártanak.
    Mutasd a teljes hozzászólást!
  • Szia!

    Köszi, ez megoldotta a problémát! :) 

    Szép napot! 

    V
    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