Ustalarım merhaba,
Mail gönderiminde gönder butonuna basınca neyle ilgili mail gönderiyorsak onun gönderi penceresini açıyor..Benim istediğim ise gönderi penceresi açmadan maili arka planda göndermesi..Bu işlem yapılabilirmi..
Kullandığım kodlar..
Option Explicit
Sub Mail_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("MailRangeSelection").Range("AK60:AK69").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
.BCC = ""
.Subject = "xxxxxxxxxxxxxxxx"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Mail gönderiminde gönder butonuna basınca neyle ilgili mail gönderiyorsak onun gönderi penceresini açıyor..Benim istediğim ise gönderi penceresi açmadan maili arka planda göndermesi..Bu işlem yapılabilirmi..
Kullandığım kodlar..
Option Explicit
Sub Mail_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("MailRangeSelection").Range("AK60:AK69").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ""
.CC = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
.BCC = ""
.Subject = "xxxxxxxxxxxxxxxx"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub