21-10-2013, 13:28
ilginize çok teşekkürler, mail gönderme için aşağıdaki kodu kullanıyorum(tablodaki tanımlı birden fazla kullanıcıya göndermek için) bu kod yapısına göre xls ek olarak direkt gönderme işini nasıl çözebilirim. yardımlarınız için teşekkürler.
NOT : kodda HTMLBODY kısmına şimdilik sabit bir text yazdım, olması gereken "KURGONDER" isimli sorgu içeriği olacak.
Sub KURGONDER(Optional AttachmentPath)
On Error GoTo HATA
Dim MyDB As Database
Dim MyRS As Recordset
Dim MyRSto As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("KURGONDER")
Set MyRSto = MyDB.OpenRecordset("KURGONDER_TO")
MyRSto.MoveFirst
Set objOutlook = CreateObject("Outlook.Application")
Do Until MyRSto.EOF
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add(MyRSto![EMAIL])
objOutlookRecip.Type = olTo
.SUBJECT = "Günlük Kur Bildirimi " & Now
.HTMLBODY = "Saat " & Time & " itibariyle kurlar aşağıdadır." _
& "<br />" _
& "<br /><strong>" & "PB : </strong>" & 1 _
& "<br /><strong>" & "KUR : </strong>" & 2 _
& "<br />"
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
Exit Sub
End If
Next
.Send
End With
MyRSto.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Exit Sub
HATA:
error_no = err.Number
End Sub
NOT : kodda HTMLBODY kısmına şimdilik sabit bir text yazdım, olması gereken "KURGONDER" isimli sorgu içeriği olacak.
Sub KURGONDER(Optional AttachmentPath)
On Error GoTo HATA
Dim MyDB As Database
Dim MyRS As Recordset
Dim MyRSto As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("KURGONDER")
Set MyRSto = MyDB.OpenRecordset("KURGONDER_TO")
MyRSto.MoveFirst
Set objOutlook = CreateObject("Outlook.Application")
Do Until MyRSto.EOF
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add(MyRSto![EMAIL])
objOutlookRecip.Type = olTo
.SUBJECT = "Günlük Kur Bildirimi " & Now
.HTMLBODY = "Saat " & Time & " itibariyle kurlar aşağıdadır." _
& "<br />" _
& "<br /><strong>" & "PB : </strong>" & 1 _
& "<br /><strong>" & "KUR : </strong>" & 2 _
& "<br />"
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
Exit Sub
End If
Next
.Send
End With
MyRSto.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Exit Sub
HATA:
error_no = err.Number
End Sub