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
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ę
Pozdrawiam