AccessTr.neT

Tam Versiyon: makro ile mail göndermek
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Sayfalar: 1 2 3
Sn Sledgeab paylaşım için teşekkürler. Saygılar...
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "TABLO1", Application.CurrentProject.Path & "\DETAY.XLS"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "TABLO2", Application.CurrentProject.Path & "\DETAY.XLS"

' + mail gönderme işlemi

Dim iMsg, iConf, Flds, schema
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "gmailadresim"
Flds.Item(schema & "sendpassword") = "gmailşifrem"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update
With iMsg
.To = "gid@ecekkişimailad.resi"
.From = "gön@deren.kişi"
.Subject = "konuumuz excelle gönderinimi"
.HTMLBody = "evettt gönderdik gitti aldınızsa bana cepten ulaşın"
.Sender = "ben"
.Organization = "yineben"
.ReplyTo = "yanlışkişiyegitti ise geri gelecek adres"
.AddAttachment Application.CurrentProject.Path & "\DETAY.XLS" 'burda stfile adlı globale atadığımız Excel dosyasının yeri adı"

Set .Configuration = iConf
On Error GoTo 10:
.Send
End With

10:
MsgBox "Kullanılabilir değil, bilgilerinizi kontrol edin."

Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing



Private Sub OUTLOOKGONDER_Click()
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "TABLO1", Application.CurrentProject.Path & "\DETAY.XLS"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "TABLO2", Application.CurrentProject.Path & "\DETAY.XLS"

'Microsoft Outlook xx.x Object Library aktifleştirmeniz gerekli
Dim appOutlook As New Outlook.Application
Set msg = appOutlook.CreateItem(olMailItem)
With msg
.To = "mail@adresim"
.Subject = "strSubject"
.Body = "strBody"
.Attachments.Add Application.CurrentProject.Path & "\detay.xls"
.Display

End With
Dim mess_body As String
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)

Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = Me.Email_Address
.Subject = Me.Mess_Subject
.HTMLBody = Me.Mess_Text
If Left(Me.Mail_Attachment_Path, 1) <> "<" Then
.Attachments.Add (Me.Mail_Attachment_Path)
End If
'.DeleteAfterSubmit = True 'This would let Outlook send th note without storing it in your sent bin
.Send
End With
'MsgBox MailOutLook.Body
Exit Sub
email_error:
MsgBox "An error was encountered." & vbCrLf & "The error message is: " & Err.Description
Resume Error_out
Error_out:
1. Mesajda hem outlook ile hem gmail ile gönderim
2. Mesajda outlook ile ginderim kodlarıdır.
Sn Nihat hocam verdiğiniz değerli bilgiler için teşekkürler. Saygılar...
selam arkadaşlar
bende bugün örneği ekleyecektim yinede ekleyeyim
verdiğiniz bilgiler için çok çok teşekkür ederim
Sayfalar: 1 2 3