Kirim Email sekaligus ke banyak penerima

            Saya  baru tahu  ternyata  ada rekan di supply chain yang harus mengirim email ke banyak penerima setiap  hari, hal ini  di lakukan untuk mengirim PO ke supplier.
PO yang  harus  di kirim berbentuk attachment  PDF file dan harus di kirim  ke banyak suplier setiap ada PO  baru.Jumlah supplier  yang harus di kirimi email mencapai  200 supplier, dan di lakukan satu persatu tergantung PO dan  supplier nya.Terlintas  di pikiran saya begitu manual dan capek nya mereka harus buat email dan meletakan attachment nya,bisa saja  PO  yang di kirim salah alamat.
dan tentunya  waktu yang dibutuhkan sangat  lama, jika kirim satu email  butuh 2 menit, maka untuk menuntaskan 200 email akan butuh 400 menit = 6 JAM  lebih ,  woooowwww....
Dan karena satu orang  yang merasa proses ini  bisa di otomisasi,dan dia juga minta dibuatkan macro nya, maka  dengan senang hati saya buatkan macro nya, gak tega mereka melakukan ini....sementara saya tahu cara nya yg lebih singkat dan akurat.


maka setelah di buatkan macro nya, untuk mengirim email ke lebih dari  200 alamat berbeda hanya  butuh  waktu  30  detik.

macro nya seperti dibawah:

Option Explicit

Const EMBED_ATTACHMENT As Long = 1454

Const stPath As String = "E:\attachment"

Sub Send_EMAIL_w_Attach()

  Dim stFileName As String
  Dim stFileName1 As String
  Dim vaRecipients As Variant
  Dim stSubject As String
  Dim noSession As Object
  Dim noDatabase As Object
  Dim noDocument As Object
  Dim noEmbedObject As Object
  Dim noAttachment As Object
  Dim stAttachment As String
  Dim stAttachment1 As String
  Dim vaMsg As Variant
  Dim vaCopyTo As Variant


'  'Copy the active sheet to a new temporarily workbook.
'  With ActiveSheet
'    .Copy
'    stFileName = .Range("E2").Value
'  End With
'
'  stFileName = Range("E2").Value
'  stFileName1 = Range("F2").Value
'  stAttachment = stPath & "\" & stFileName
'  stAttachment1 = stPath & "\" & stFileName1

  'Save and close the temporarily workbook.
'  With ActiveWorkbook
'    .SaveAs stAttachment
'    .Close
'  End With

Range("A2").Select
Dim r, k1, k2, k3, k4, k5, k6, I, b As Integer
r = 2
k1 = 1
k2 = 2
k3 = 3
k4 = 4
k5 = 5
k6 = 6
 b = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
 'On Error Resume Next
 For r = 1 To b
   ' If ActiveCell.Value <> "" Then
   
   
  stSubject = Cells(r, k1).Value 'email title
  vaMsg = Cells(r, k2).Value ' email body
  vaRecipients = Cells(r, k3).Value ' email adress to
  vaCopyTo = Cells(r, k4).Value ' email adress cc
 
  '======attachment=======================
   stFileName = Cells(r, k5).Value   'attachment 1
  stFileName1 = Cells(r, k6).Value   'attachment 2
  stAttachment = stPath & "\" & stFileName
  stAttachment1 = stPath & "\" & stFileName1
  '========================================
 
  'Instantiate the Lotus Notes COM's Objects.
  Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GETDATABASE("", "")

  'If Lotus Notes is not open then open the mail-part of it.
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

  'Create the e-mail and the attachment.
  Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
 
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment1")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment1)
 

  'Add values to the created e-mail main properties.
  With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    .CopyTo = vaCopyTo
    .Subject = stSubject
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With

  'Release objects from memory.
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing

    'r = r + 1
    ActiveCell.Offset(1, 0).Activate
   ' End If
   
   Next r

End Sub

Post a Comment

15 Comments

  1. This comment has been removed by the author.

    ReplyDelete
  2. Itu bhs apa? G bs baca, padahal pingin bisa kirim email ke banyak prang sekaligus.

    ReplyDelete
  3. siang mas, saya pemula dan agak bingung untuk menerapkannya.
    bisa dipandu langkah-langkah pengerjaannya mas ?
    kebetulan di tempat kerja saya punya masalah yang sama :)
    terima kasih sebelumnya.

    ReplyDelete
    Replies
    1. mas bryan, ikuti langkah langkah berikut:
      1.buka new workbook excel
      2.buat satau sheet yang isi nya seperti di atas ( sheet ini adalah data nama dan alamat yang akan kita kirimin email
      3. copy macro di atas ke modul VBA
      4. selesai

      Delete
    2. This comment has been removed by the author.

      Delete
    3. Pak, untuk kolom attachment1 dan attachment2 itu pakai formula apa ya di excel nya ?

      Delete
  4. This comment has been removed by the author.

    ReplyDelete
  5. PAK Saya masih awam dengan macro ini, mohon bantuanya, saya juga memiliki kasus seperti ini, mengirim invoice ke banyak alamat
    setiap bulan harus mengirim email ini 1300 email. mohon kalo boleh berbagi ilmunya..
    bagaimana cara penerapannya ya? masih bingung

    ReplyDelete
  6. pak, bisa dijelaskan dari awal caranya?
    saya sudah coba tapi gak ada respon
    *saya masih sangat awam dengan macro.
    terima kasih.

    ReplyDelete
  7. Dear Pak Effendi,
    Mohon Kiranya Komentar saya ini dibalas
    Untuk Attachment bagaimana formatnya di excel, karena saya lihat beberapa website lain menggunakan lokasi seperti D:/bla/bla

    ReplyDelete
    Replies
    1. ikutin step by step nya saja, mana yg kurang paham bisa di tanyakan bagian mana, mengenai format attachement nya.. gak ada yg special, excel file biasa, atau PDF, atau word.

      Delete
  8. Pak saya punya kasus yang sama. tapi untuk cara ini penerapannya untuk excel versi berapa pak? apakah bisa di semua versi?
    karena masih bingung analogika pak.

    ReplyDelete
  9. kok error "active x cant create object"

    ReplyDelete