Skip to main content

AccessTr.neT M.



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

Visual Basic Code
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 Adlı Kullanıcıdan Alıntı: 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

Visual Basic Code
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