hasanyaprak
Altın Üye
- Katılım
- 9 Aralık 2010
- Mesajlar
- 69
- Excel Vers. ve Dili
- İş office 2021 / Ev ofis 2016 64 bit
- Altın Üyelik Bitiş Tarihi
- 13-10-2025
Merhaba,
Aşağıdaki gibi bir makro kullanıyorum. Klasör altından pdf ekleyerek mail gönderme işlemini yapıyor. Buna ek olarak aynı maile I15 P31 hücre aralığında bir tablom var. Bu tabloyu mail sayfasına kopya alabilmek mümkün olur mu yardımınızı rica ederim. Kodlarda sipariş tablosu yazan alanın hemen altına koymak istiyorum. Ayrıca imza koyduğumda Body yazan kısımdaki açıklamaları siliyor.
Private Sub CommandButton4_Click()
myDate = Date
'selis = "Kapasite" & myDate
Set ds = CreateObject("Scripting.FileSystemObject")
kls = " C:\Users\HASAN\Desktop\2- Tasarım Sunumları \"
If Dir(kls) = "" Then MsgBox "Klasor yok": Exit Sub
Set dc = ds.getfolder(kls).Files 'dosyaların bulunduğu yol
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "hasanyaprak_@hotmail.com "
.CC = " hasanyaprak_@hotmail.com "
.Subject = myDate & " BBSG " & " - Sipariş "
.HTMLBody = "Merhaba," & "<br><br>" & "Aşağıdaki tabloda sipariş nosu verilen proje için XXXX teminini rica ederiz." & "<br><br><br><br>" & "Sipariş Tablosu" & "<br>" & "KOPYA YAPILACAK ALAN" & "<br><br><br><br><br>" & "İyi Çalışmalar" & "<br>" & "Hasan Yaprak"
' .HTMLBody = Sheets("Mail Gönder").Range("c1:c5").Value & vbNewLine 'BURAYI YAZMIYOR
'.Body = "deneme"
For Each Dosya In dc
.Attachments.Add Dosya.Path 'dosyaların bulunduğu yol"
Next
.Display
End With
On Error GoTo 0
Aşağıdaki gibi bir makro kullanıyorum. Klasör altından pdf ekleyerek mail gönderme işlemini yapıyor. Buna ek olarak aynı maile I15 P31 hücre aralığında bir tablom var. Bu tabloyu mail sayfasına kopya alabilmek mümkün olur mu yardımınızı rica ederim. Kodlarda sipariş tablosu yazan alanın hemen altına koymak istiyorum. Ayrıca imza koyduğumda Body yazan kısımdaki açıklamaları siliyor.
Private Sub CommandButton4_Click()
myDate = Date
'selis = "Kapasite" & myDate
Set ds = CreateObject("Scripting.FileSystemObject")
kls = " C:\Users\HASAN\Desktop\2- Tasarım Sunumları \"
If Dir(kls) = "" Then MsgBox "Klasor yok": Exit Sub
Set dc = ds.getfolder(kls).Files 'dosyaların bulunduğu yol
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "hasanyaprak_@hotmail.com "
.CC = " hasanyaprak_@hotmail.com "
.Subject = myDate & " BBSG " & " - Sipariş "
.HTMLBody = "Merhaba," & "<br><br>" & "Aşağıdaki tabloda sipariş nosu verilen proje için XXXX teminini rica ederiz." & "<br><br><br><br>" & "Sipariş Tablosu" & "<br>" & "KOPYA YAPILACAK ALAN" & "<br><br><br><br><br>" & "İyi Çalışmalar" & "<br>" & "Hasan Yaprak"
' .HTMLBody = Sheets("Mail Gönder").Range("c1:c5").Value & vbNewLine 'BURAYI YAZMIYOR
'.Body = "deneme"
For Each Dosya In dc
.Attachments.Add Dosya.Path 'dosyaların bulunduğu yol"
Next
.Display
End With
On Error GoTo 0
Son düzenleme:
