Skip to main content

AccessTr.neT


Excel Kitaplar Arası Geçişte Problem

Excel Kitaplar Arası Geçişte Problem

#19
Ekledim dosyayı.
.rar MailBodyEkle_hy.rar (Dosya Boyutu: 1,05 MB | İndirme Sayısı: 3)
Cevapla
#20
benim gönderdiğim dosyada "modül3" vardı, "rangetohtml()" fonksiyonu orada tanımlıydı. "Modul3" silinmiş
ama  eğer tek hücre ekleyecekseniz yani sadece "K" yı o zaman modüle falan gerek yok doğrudan 
kodu aşağıdaki gibi yapın
Sub MailActiveSheet()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim i As Integer
Dim rng As Range
Set rng = Nothing

i = ActiveCell.Row '<======== i= seçtiğimiz satırı gösterir satırdaki herhangi bir hücreye basılabilir
       
With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


   On Error Resume Next
   With OutMail
       .to = ""
       .CC = ""
       .BCC = ""
       .Subject = "IT WORK ORDER"
               .Body = "Sayın İlgililer:" & vbNewLine & _
                   "IT Departmanı ile ilgili yeni oluşturulan iş emrini aşağıda görebilirsiniz." & _
                    vbNewLine & "İyi Çalışmalar" & vbNewLine & vbNewLine & _
                    Range("K" & i).Value
       '.Attachments.Add Destwb.FullName
       '.Send
       .Display
   End With
   On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With Application
   .ScreenUpdating = True
   .EnableEvents = True
End With
End Sub
Cevapla
#21
(11/05/2019, 02:16)haliliyas yazdı: ama  eğer tek hücre ekleyecekseniz yani sadece "K" yı o zaman modüle falan gerek yok doğrudan 
kodu aşağıdaki gibi yapın
Sub MailActiveSheet()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim i As Integer
Dim rng As Range
Set rng = Nothing

i = ActiveCell.Row '<======== i= seçtiğimiz satırı gösterir satırdaki herhangi bir hücreye basılabilir
       
With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


   On Error Resume Next
   With OutMail
       .to = ""
       .CC = ""
       .BCC = ""
       .Subject = "IT WORK ORDER"
               .Body = "Sayın İlgililer:" & vbNewLine & _
                   "IT Departmanı ile ilgili yeni oluşturulan iş emrini aşağıda görebilirsiniz." & _
                    vbNewLine & "İyi Çalışmalar" & vbNewLine & vbNewLine & _
                    Range("K" & i).Value
       '.Attachments.Add Destwb.FullName
       '.Send
       .Display
   End With
   On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With Application
   .ScreenUpdating = True
   .EnableEvents = True
End With
End Sub

Tamam Hocam sehven silmişim Modül 3 ü. Ama dediğiniz gibi sadece K'yı ekleyeceğim. En son gönderdiğiniz kodlamayı kullandım. Çalıştı.

Emeğinize sağlık. Teşekkür ederim.

Saygılarımla
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task