- Katılım
- 10 Ağustos 2017
- Mesajlar
- 159
- Excel Vers. ve Dili
-
Excel 2017
Türkçe
- Altın Üyelik Bitiş Tarihi
- 11-03-2023
Merhaba ,
Aşağıdaki kod ile excelden maili açmadan ilgili kişilere mail atıyorum. Ancak bazen yanlışlıkla mail gönderme butonuna basıyorum ve mail gereksiz yere gidiyor. Kodun sonuna onay eklememiz mümkün mü acaba.
Mail gönderilecek Onaylıyor musunuz vb. bir uyarı olsa yeterli.
Ancak kod konusunda bilgim çok zayıf.
Sub imzalı()
Dim OutApp As Object
Dim Outmail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile(ActiveWorkbook.Path & "\mailbody.htm")
Signature = oFS.readall
Konu = Cells(1, "AA").Value
kime = Cells(2, "AA").Value
bilgi = Cells(3, "AA").Value
On Error Resume Next
With Outmail
.To = kime
.CC = bilgi
.Subject = Konu
.Attachments.Add ActiveWorkbook.Path & "\image001.jpg", olByValue, 0
.Attachments.Add ActiveWorkbook.Path & "\image002.jpg", olByValue, 0
.Attachments.Add (ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
.HTMLBody = Signature
.Display
.Send
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub
Aşağıdaki kod ile excelden maili açmadan ilgili kişilere mail atıyorum. Ancak bazen yanlışlıkla mail gönderme butonuna basıyorum ve mail gereksiz yere gidiyor. Kodun sonuna onay eklememiz mümkün mü acaba.
Mail gönderilecek Onaylıyor musunuz vb. bir uyarı olsa yeterli.
Ancak kod konusunda bilgim çok zayıf.
Sub imzalı()
Dim OutApp As Object
Dim Outmail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFS = oFSO.OpenTextFile(ActiveWorkbook.Path & "\mailbody.htm")
Signature = oFS.readall
Konu = Cells(1, "AA").Value
kime = Cells(2, "AA").Value
bilgi = Cells(3, "AA").Value
On Error Resume Next
With Outmail
.To = kime
.CC = bilgi
.Subject = Konu
.Attachments.Add ActiveWorkbook.Path & "\image001.jpg", olByValue, 0
.Attachments.Add ActiveWorkbook.Path & "\image002.jpg", olByValue, 0
.Attachments.Add (ActiveWorkbook.Path & "\" & ActiveWorkbook.Name)
.HTMLBody = Signature
.Display
.Send
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub