Si t dergoj email nga Access 2007

[nince_tutes]

Pershendetje.

Kam nje databaze n Access 2007, per kontakte, ku i ruaj t dhena si emri, kompania, celi, etj etj, por edhe emailin.

dua q t krijoj nje buton psh, q kur ta klikoj, t'i dergoj automatikisht email, t gjithe personave q kam t regjistruar n databaze, pra tek

To:

e microsoft outlook-ut, psh, t mbushet me t gjithe emailet q kam n databaze, psh 100 rekorde me 100 emaile, dhe t'i coj email.

cfare duhet???

flm.

[hot_prinz]

http://support.microsoft.com/kb/318881/en-us

Option Compare Database
Option Explicit

Sub SendMessages(Optional AttachmentPath)

  Dim MyDB As Database
  Dim MyRS As Recordset
  Dim objOutlook As Outlook.Application
  Dim objOutlookMsg As Outlook.MailItem
  Dim objOutlookRecip As Outlook.Recipient
  Dim objOutlookAttach As Outlook.Attachment
  Dim TheAddress As String

  Set MyDB = CurrentDb
  Set MyRS = MyDB.OpenRecordset("tblMailingList")
  MyRS.MoveFirst

  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")
  
  Do Until MyRS.EOF
  ' Create the e-mail message.
  Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
  TheAddress = MyRS![EmailAddress]

     With objOutlookMsg
        ' Add the To recipients to the e-mail message.
        Set objOutlookRecip = .Recipients.Add(TheAddress)
        objOutlookRecip.Type = olTo

        ' Add the Cc recipients to the e-mail message.
        If (IsNull(Forms!frmMail!CCAddress)) Then
        Else
           Set objOutlookRecip = .Recipients.Add(Forms!frmMail!CCAddress)
           objOutlookRecip.Type = olCC
        End If
   
        ' Set the Subject, the Body, and the Importance of the e-mail message.
        .Subject = Forms!frmMail!Subject
        .Body = Forms!frmMail!MainText
        .Importance = olImportanceHigh  'High importance
        
        'Add the attachment to the e-mail message.
        If Not IsMissing(AttachmentPath) Then
           Set objOutlookAttach = .Attachments.Add(AttachmentPath)
        End If

        ' Resolve the name of each Recipient.
        For Each objOutlookRecip In .Recipients
           objOutlookRecip.Resolve
           If Not objOutlookRecip.Resolve Then
             objOutlookMsg.Display
           End If
        Next
        .Send
      End With
      MyRS.MoveNext
   Loop
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
End Sub