Butonla Outlook`a Gorev Atama

[senol1979]

Başkasına görev atamak. Sizin dosyanız üzerinden devam edersek J1 hücresinde mail adresi yazılı kişiye görev atamak. ( Şirket içinde bir işlem olduğu için, bu kişide outlook kullanıcısı.)

 

[senol1979]

Bu görevin içine excel çalışma sayfasını nasıl ekleriz acaba. Uğraşıyorum ama sonuç alamadım.
.Body = Cells (22,17) yerine .HTMLBody =........ şeklinde ne veya neler yazılmalı.
Görevi mail ile atama ile de uğraştım ama tek becerebildiğim ".Assign" ekleyerek görev içinde kime kısmını boş olarak açmak oldu. Ancak bu kısma mail adresini girmeyi ve göndermeyi beceremedim.

 

[mustafaine1]

acikcasi baskasina gorev atama yapilabildigini sanmiyorum, ancak baska bir butonla baskasina c sutununu content olara secip mailk atabilirsiniz, sitede mail atmakla ilgili bir cok ornek var, inceleyin, atama konusunda yardimci olamadigim icin uzgunum ama baskasindan ayrica yardim gelirse bende memnun olurum

 

[senol1979]

Teşekkürler. Başkasına görev atama için illaki yapmam gerek demiyorum ama sayfayı gövde olarak getirmeyi halletmem gerekiyor. Mail atma ile ilgili çalışmaları gözden geçirdim. Hatta birinde mesaj gövdesine çalışma sayfasını ekleme ile ilgili kodlar da vardı. Ancak bu kodları görev açmaya uygulayamadım.

 

[senol1979]

Mesaj için kullandığım ( Mail atmak için ) kodlar:
Sub Mail_ActiveSheet_Body()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = Worksheets("FORM").Range("Q17")
.CC = ""
.BCC = ""
.Subject = Worksheets("FORM").Range("B3").Value & "Numaralı İş Emri Açılmıştır"
.HTMLBody = SheetToHTML(ActiveSheet)
.Send 'or use .Display
End With
Application.ScreenUpdating = False
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Bu kodlarda sayfayı html olarak ekliyor (Yanılmıyorsam)

Public Function SheetToHTML(sh As Worksheet)
Dim TempFile As String
Dim Nwb As Workbook
Dim myshape As Shape
Dim fso As Object
Dim ts As Object
sh.Copy
Set Nwb = ActiveWorkbook
For Each myshape In Nwb.Sheets(1).Shapes
myshape.Delete
Next
TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile
End Function

Burayı uyarlamayı beceremedim.

 

[mustafaine1]

ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
      .Introduction = ""
      .Item.To = [A2].Value
       '.Item.CC = ""
      .Item.Subject = [C2].Value
      '.Item.Attachments.Add ""
      .Item.Send
   End With

bu tarz bir kodla cozulebilir sanirim..

 

[senol1979]

Teşekkürler Mustafa Bey. VBA konusunda biraz bilgim olsada özellikle başka programlara işlem yaptırma konusunda pek bilgili değilim. [Uyarlama fena değil :-( ] Bu yazdığınız kodlar, görev oluşturma esnasında aktif sayfayı gövdeye ( sizin kodlarınız da .Body=cells(22,17).value ile tanımlı kısma) ekleme işlemini gerçekleştiriyor. Anlatması biraz zor oldu ama umarım başarabilmişimdir.
Resimdeki gibi.

 

[mustafaine1]

sanirim yapicaginiz sey daha kapsamli olucak ben kodlari denemedim fakat baska bi calismamda halen kullaniyorum.. .Introduction = "" bolumune yazdiklariniz body olarak gidecektir.. ben mail atarken gereken detaylari yazmaya calistim ama ne kadar isinbizi gorur bilemiyorum.. Baska programlarla ozellikle outlook konusunda bende iyi degilim ki ornek calismayida cok iyi bir sekle sokamadigim icin kullanmaktan vazgectim umarim sizin isinizi gorebilir..

 

[senol1979]

Mustafa Bey iyi haberlerim var. Epey bir araştırma ve birazda şansla açılan görevi birine mail ile otomatik olarak atamayı yapan kodları buldum. Aslında sabahtan beri denediğim ve bir parantez birde sıralama hatası nedeniyle yapamamış olduğumu gördüm. Tek eksik çalışma sayfasını body (gövde olarak) eklemek kaldı.
Kodların son hali.

Option Explicit

Sub Create_Task()
'Microsoft Object Library x.x referansi tool menusunden acilmali..

Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim olItemToChange As Outlook.TaskItem
Dim olNS As Object
Dim olItems As Object

Dim X As Long

Set olApp = New Outlook.Application

Application.ScreenUpdating = False

Set olNS = olApp.GetNamespace("MAPI")
'Set olTask = olNS.GetDefaultFolder(13).Items
'Set olItemToChange = olItems.Find("[Subject] = DDDD")
On Error Resume Next
Set olItemToChange = Nothing
Set olItemToChange = olNS.GetItemFromID(Cells(20, 17).Value)
'olTask .Find("[EntryID] = 'FFF'") '& Cells(20, 17).Value)
'If Cells(20, 17).Value = "" Then
If olItemToChange Is Nothing Then

Set olTask = olApp.CreateItem(3)
With olTask
.Subject = Worksheets("FORM").Cells(21, 17).Value
.Body = Worksheets("FORM").Cells(22, 17).Value
.StartDate = Worksheets("FORM").Cells(3, 12).Value
.DueDate = Worksheets("FORM").Cells(6, 12).Value
.Status = olTaskWaiting
.Importance = olImportanceHigh
.ReminderSet = False
.ReminderTime = ""
.ReminderPlaySound = False
.Save
.Recipients.Add ("aaaa@gmail.com")
.Assign
.Send
End With
Worksheets("FORM").Cells(20, 17).Value = olTask.EntryID
End If

Set olTask = Nothing
Set olApp = Nothing

Application.ScreenUpdating = True

End Sub

İlgili yerin linki. Umarım site açısından bir sakıncası yoktur.
http://www.ozgrid.com/forum/showthread.php?t=15716&page=1

 

[mustafaine1]

bu site benim cok begendigim ve surekli takip ettigim bir site, mesajiniza goz atmaya calisicam cok yogun oldugum icin bir turlu ilgilenemedim, gerekli oldugunu dusundugum bir eklemem olursa paylasirim, kolay gelsin..