Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

jak wysłać e-maila

28 views
Skip to first unread message

Szczypiorek

unread,
Nov 27, 2009, 2:22:28 PM11/27/09
to
Panowie proszę o pomoc w rozgryziemiu problemu.
Muszę przygotować bazę w accesie, która pozwoli mi na automatyczn
wysyłkę e-maili do 5 do 300 osób. Każda z nich ma w mailu dostać
załącznik z indywidualnym raportem.
Z większością spraw sobie poradziłem ( kod poniżej ) nie wiem tylko
jak i co zrobić żeby outlook nie wołał o 300 potwierdzeń wysyłki
maila. Myślałem, że C2OutlookWarningDoctor rozwiąże problem, ale nie.
Jako że pracuję w dużej instytucji nie mogę ominąć outlooka.
Czekam na sugestie.
Pozdrawiam.

Public Sub wyslij()
On Error Resume Next
Dim db As Database
Dim adres As String
Dim rs As Recordset
Dim id_prac As Long
Dim opis As String
Dim tytul As String
Dim pracownik As String
Dim nazwa_zalacznika As String

opis = "W załączeniu aktualna lista." & vbNewLine & "" & vbNewLine &
"Do otwarcia i przeglądu załączonego pliku rekomendujemy użycie
aplikacji WordPad MFC." & vbNewLine & "" & vbNewLine & "" & vbNewLine
& podpis()
nazwa_zalacznika = "Lista"

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT id_pracownika as id_prac, email
as adres, nazwisko_i_imie as pracownik FROM tbl_adresaci")
rs.MoveFirst
id_prac = rs!id_prac
adres = rs!adres
pracownik = rs!pracownik
prac = id_prac

Do While Not rs.EOF

tytul = "Lista" & " " & [pracownik] & " " & Now()
DoCmd.SendObject acSendReport, [nazwa_zalacznika], acFormatTXT,
[adres], "", "", [tytul], [opis], True, ""
rs.MoveNext
id_prac = rs!id_prac
adres = rs!adres
pracownik = rs!pracownik
prac = id_prac

Loop
rs.Close
Set rs = Nothing

End Sub

Jacek

unread,
Nov 28, 2009, 12:18:23 AM11/28/09
to

Szczypiorek

unread,
Nov 28, 2009, 2:38:09 AM11/28/09
to
Dziękuję Jacku.
Poczytałem, pomyślałem i udało mi się rozwiązać większość problemów.
Wysyłka chodzi może trochę wolno, za to po jednym kliknięciu.
Jednak, jak to w życiu bywa, rozwiązanie jednego problemu rodzi
kolejne.
Zaletą metody SendObject jest to, że pozwala wysyłać raporty tworzone
w oparciu o parametr z procedury - u mnie jest to parametr id_prac.
W nowym rozwiązaniu mogę do e-maila dodawać jedynie załączniki.
Oczywiście mogę oprogramować export raportu do pliku przy każdej
pętli, ale przy masówce zajmie to sporo czasu.
Czy ktoś może wie jak obejść ten problem i zamiast załącznika z
określonej lokalizacji móc podpinać raport wprost z accessa?

pozdrawiam

Public Sub wyslij()
'poniższa deklaracja pozwala na zakończenie pętli bez wyświetlania
komunikatu o błędzie
On Error Resume Next

'deklaracje zmiennych do wybierania pracowników


Dim db As Database
Dim adres As String
Dim rs As Recordset
Dim id_prac As Long
Dim opis As String
Dim tytul As String
Dim pracownik As String

Dim zalacznik As String

'deklaracje zmiennych do wysłania e-maila
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim AttachmentPath As String

opis = "W załączeniu aktualna Lista." & vbNewLine & "" & vbNewLine


& "Do otwarcia i przeglądu załączonego pliku rekomendujemy użycie
aplikacji WordPad MFC." & vbNewLine & "" & vbNewLine & "" & vbNewLine
& podpis()

' wybieranie pracownika z listy do wysyłki

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT id_pracownika as id_prac, email
as adres, nazwisko_i_imie as pracownik FROM tbl_adresaci")
rs.MoveFirst
id_prac = rs!id_prac
adres = rs!adres
pracownik = rs!pracownik
prac = id_prac

'początek pętli wybierania kolejnych pracowników
Do While Not rs.EOF

tytul = "Lista" & " " & [pracownik] & " " & Now()

'w tym miejscu zaczyna się kod pozwalający na wysłanie informacji
z outlooka
'przepis pobrany ze strony http://www.granite.ab.ca/access/email/outlook.htm
'przepis pobrany ze strony http://support.microsoft.com/?kbid=209948

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add([adres])
objOutlookRecip.Type = olTo

' Set the Subject, Body, and Importance of the message.
.Subject = tytul
.Body = opis & vbCrLf & vbCrLf
'.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
AttachmentPath = "E:\zal.txt"
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If

.Send

End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing

rs.MoveNext
id_prac = rs!id_prac
adres = rs!adres
pracownik = rs!pracownik
prac = id_prac

Loop
' loop kończy pętlę

Szczypiorek

unread,
Nov 28, 2009, 11:55:16 AM11/28/09
to
Jak mawiał doktor Štrosmajer, gdyby głupota miała skrzydła to latałbym
jak gołębica.
Mój problem z otwierającym się oknem dialogowym outlooka rozwiązała
zmiana parametru True na False w następującej linii kodu:

DoCmd.SendObject acSendReport, [nazwa_zalacznika], acFormatTXT,
[adres], "", "", [tytul], [opis], False, ""
Problem irytującego okienka ostrzegawczego w outlooku, przynajmniej
częściowo rozwiązuje program O2OutlookWarningDoctor.

Pozdrawiam

0 new messages