• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makroyla email gonderme

email gönderme

Hemen hemen hergün kendi kullandığım bir kodum var bunu sizinle paylaşmak isterim.

Kod:
Private Sub yolla_click()
Dim wb As Workbook
Dim strdate As String
Dim name, isim, plaka As String
    plaka = Sheets("form").Range("f8").Value
    isim = Sheets("form").Range("c6").Value
    strdate = Format(Now, "dd-mm-yy ")
    name = isim & " " & plaka & " " & strdate & ".XLS"
    Application.ScreenUpdating = False
    ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
        .SaveAs "c:\" & name
        .SendMail "tarkanvural@hotmail.com", _
                  "Sipariş Formu"
        .Close False
End With
    Application.ScreenUpdating = True
    Kill "c:\" & name

End Sub

SAYGILARIMLA;
Tarkan VURAL
 
Sayın reider kodları bir excel dosyasına kadedip yaptığımda problemsiz çalıştı. Ancak personal dosyasına tanımladığımda debug veriyor. Gönderilen excel dosyasını siliyor giden sayfa da boş gidiyor. Hata verdiği yeri
ekledim. Teşekkürler.

Kill WbName----Burada debug veriyor.
End Sub
 
tamercan,

Ben Personal.xls dosyası ile pek ( hatta, hiç) çalışmam.

Emin olmamakla birliktre aşağıdaki satırı
Kod:
ThisWorkbook.SaveCopyAs WbName

aşağıdaki satırla değiştirip, bir deneyin.

Kod:
ActiveWorkbook.SaveCopyAs WbName
 
Sayın Reider sonuç alamadım, ama diğer makrolarda böyle bir sorun yaşamamıştım. Neyse önemli değil bende kullanacağım excel dosyasına makro olarak kaydedip öyle kullanırım yardımların için teşekkürler.
 
Raider, vermiş olduğun kodu kullanıyorum ve çok işime yarıyor ancak bu konu ile ilgili farklı bir ihtiyacım çıktı ortaya.

Þöyle anlatayım.

Ã?ncelikle bir çok ile ait verileri ayrı sheetlere atıyorum. Buradan da send e-mail yaparken şunların olmasını istiyorum

1- Oraya aktarılan bilgilerin sadece belli bir bölümünü (A1 den F10 na kadar seçili alan mesela) mailin içine tablo olarak aktararak (dosya olarak değil) gönderebilirmiyim

2- O tablo ile ilgili açıklamayı ise dosyanın herhangi bir yerine koyacağım açıklama ile gönderebilirmiyim. (Açıklama tablo ile ayrıntıları veriyor. Sabit bir yazı olmadığından makronun içine yazmak sorun olabilmekte. O yüzden ona vereceğim bir hücreye gidip oaradaki açıklamayı alıp yapıştırması gerekiyor

3- Kime gideceği kısmı makro içine yazılarak değilde, farklı bir sheette yer alan illerin karşısındaki kişileri (to.. ve cc.. olarak) bulup yazsa. Yani İSTANBUL a ait tablo gönderiliyorsa, oradaki yetkili kişileri sheet 2 de bulup to ve cc. yapsa.

Çok şey istedim biliyorum ama sanırım bu tür makroya ihtiyacı olan çok arkadaşımda çıkacaktır. Yardımlarınızı esirgemezseniz sevinirim :?
 
melwitch' Alıntı:
Oraya aktarılan bilgilerin sadece belli bir bölümünü (A1 den F10 na kadar seçili alan mesela) mailin içine tablo olarak aktararak (dosya olarak değil) gönderebilirmiyim

Bu işi biraz daha değiştirir.

Þimdilik aşağıdakini bir deneyin... Aktif sayfanın A1:F10 aralığını mail' in gövdesine, A20 hücresine yazılan metni de mail'in "Subject - Konu" bölümüne yerleştirir.

[vb:1:e6b05e3184]Sub EmailSheet()
Dim OutlookApp As Object, OutlookMsg As Object
Dim FSO As Object, BodyText As Object
Dim MyRange As Range, TempFile As String

On Error Resume Next
Set MyRange = ActiveSheet.Range("A1:F10")
If MyRange Is Nothing Then Exit Sub
Set FSO = CreateObject("Scripting.FilesystemObject")
TempFile = "C:\TempHTML.htm"
ActiveWorkbook.PublishObjects.Add _
(4, TempFile, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMsg = OutlookApp.CreateItem(0)
Set BodyText = FSO.OpenTextFile(TempFile, 1)

With OutlookMsg
.HTMLBody = BodyText.ReadAll
.Subject = Range("A20").Text
.To = "raider@hotmail.com"
.cc = "raider@yahoo.com"
.Display
End With

Kill TempFile

Set BodyText = Nothing
Set OutlookMsg = Nothing
Set OutlookApp = Nothing
Set FSO = Nothing
End Sub
[/vb:1:e6b05e3184]
 
2- O tablo ile ilgili açıklamayı ise dosyanın herhangi bir yerine koyacağım açıklama ile gönderebilirmiyim. (Açıklama tablo ile ayrıntıları veriyor. Sabit bir yazı olmadığından makronun içine yazmak sorun olabilmekte. O yüzden ona vereceğim bir hücreye gidip oaradaki açıklamayı alıp yapıştırması gerekiyor

3- Kime gideceği kısmı makro içine yazılarak değilde, farklı bir sheette yer alan illerin karşısındaki kişileri (to.. ve cc.. olarak) bulup yazsa. Yani İSTANBUL a ait tablo gönderiliyorsa, oradaki yetkili kişileri sheet 2 de bulup to ve cc. yapsa.

PEKİ BUNLARI GERÇEKLEÞTİRMEK MÜMKÜN OLABİLECEKMİ?
 
Yukarıdaki kod, 1nci ve 2nci sorunuzun cevabıdır.

Eğer buraya kadarı işinize yaradıysa, bir şekilde 3ncü ve son kısmı için de birşeyler yapılabilir.
 
Subject kısmında sorun yok. A1:F10 arasındaki tabloyu komple aktarması gerekirken hiç bir şey çıkmıyor. Ayrıca A1:F10 aralığı ile birlikte mesala G1 e yazılı tablo için açıklayıcı bilgilerinde aktarılması gerekmekte.
 
Ã?rnek bir dosya üzerinde denedikten sonra kodu yolladım, bende bir problem olmadı...

Kendi dosyanızı buraya eklerseniz, bir bakalım...
 
Ã?rnek bir dosya yarattım bir bakarsanız sevinirim. Ayrıca vb kodunda subject kısmının A2 hücresindeki yazan şeyle + A22 deki yazan şeyin birleşimi olması için gereken koduda yapabilirmisiniz.

yardımlaırnız için çok teşekkür
 
Herhangibir problem görünmüyor, tablo e-mail'in gövdesine arslanlar gibi yerleşiyor .... :mrgreen:

Unutmamanız gereken, e-mail göndernek istediğiniz sayfa aktif iken ilgili makroyu çalıştırmanız.

Diğer taraftan, A2 de yazan şeyle, A22 de yazan şeyin birleştirilerek, e-mail'in Subject kısmına yazılması için, aşağıdaki satırı orjinali ile değiştirin...

Kod:
.Subject = Range("A2").Text & " " & Range("A22").Text
 
Sorunu buldum. Siz C: yi kullanıyorsunuz ben F: yi kullanıyorum.
O nedenle almıyormuş. "TempFile = "F:\TempHTML.htm"" yapınca oldu :)

Ancak bir şey daha var.. Biliyorum bıktınız benden ama. Tabloyu gidip mailin ortasına yerleştiriyor. Oysa ben sola yanaşık olsun istiyorum. Bunun için nereyi düzeltmem gerekiyor. Ayrıca tablonun üstüne veya altına bir açıklama koymam gerekse onu nereye yazmalıyım ki açıklama koymak zorundayım zaten. :dua:
 
Koddaki TempFile kısmında herhangibir değişiklik yapmanıza gerek yok.

Adı üstünde zaten, TemporaryFile, işi bitince kodun sonunda siliyoruz.

Tablonun sağ-sol olarak biçimlendirmesi sizi çok fazla rahat etmiyorsa, bu şekilde kullanın derim.

Diğer taraftan, tabloyu ekledikten sonra yine aynı aktif sayfanın G1 hücresinde yazılanlar da, tablonun altında e-mail gövdesinde yer alacaktır.

[vb:1:94133aa058]Sub EmailSheet2()
Dim OutlookApp As Object, OutlookMsg As Object
Dim FSO As Object
Dim BodyText1 As Object, BodyText2 As Object
Dim MyRange As Range
Dim TempFile1 As String, TempFile2 As String

TempFile1 = "C:\TempHTML1.htm"
TempFile2 = "C:\TempHTML2.htm"

Set FSO = CreateObject("Scripting.FilesystemObject")

On Error Resume Next

Set MyRange = ActiveSheet.Range("A1:F10")
If MyRange Is Nothing Then Exit Sub
ActiveWorkbook.PublishObjects.Add _
(4, TempFile1, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True

Set MyRange = ActiveSheet.Range("G1")
ActiveWorkbook.PublishObjects.Add _
(4, TempFile2, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMsg = OutlookApp.CreateItem(0)
Set BodyText1 = FSO.OpenTextFile(TempFile1, 1)
Set BodyText2 = FSO.OpenTextFile(TempFile2, 1)

With OutlookMsg
.HTMLBody = BodyText1.ReadAll & BodyText2.ReadAll
.Subject = Range("A2").Text & " " & Range("A22").Text
.To = "raider@hotmail.com"
.CC = "raider@yahoo.com"
.Display
End With

Kill TempFile1
Kill TempFile2

Set BodyText2 = Nothing
Set BodyText1 = Nothing
Set OutlookMsg = Nothing
Set OutlookApp = Nothing
Set MyRange = Nothing
Set FSO = Nothing
End Sub
[/vb:1:94133aa058]
 
Ortaya başka bir sorun daha çıktı :agla:

Yollanacak tabloda A1:F10 örnek olarak verilmişti. Bazen tabloda A1:F2 de bilgi olabiliyor, bazen A1: F50 de bilgi olabiliyor. Tabi az veri olduğunda boşlukları göndermek istemiyeceğim gibi, uzadığı zamanda eksik göndermemem gerekiyor. Anlayacağın benim işim bitecek gibi görünmüyor :)

:kafa:
 
tablonun ortada olmaması gerekiyor maalesef :( sizin için çok zor olmazsa ne eklemem gerektğini veya değiştirmem gerektiğini öğrenebilirimiyim. biliyorum acaip zahmet verdim bugün size ama.. lütfeeennnn bana kızmayın. sayenizde çok yol katettim ama formatı bir türlü istediğim gibi oturtamadım :(
 
Pekala ........ ortaya çıkan son probleminle ilgili olarak, F sütunundaki en son dolu olan hücreye göre yukarıda en son verdiğim kodu, tekrar revize ettim.

Ayrıca G1 hücresindeki tablo açıklaması da, e-mail'in gövdesinde tablonun altına eklenmektedir.

[vb:1:ca498f1917]Sub EmailSheet3()
Dim OutlookApp As Object, OutlookMsg As Object
Dim FSO As Object
Dim BodyText1 As Object, BodyText2 As Object
Dim MyRange As Range
Dim TempFile1 As String, TempFile2 As String
Dim NoF As Long

NoF = Range("F65536").Cells.End(xlUp).Row
TempFile1 = "C:\TempHTML1.htm"
TempFile2 = "C:\TempHTML2.htm"

Set FSO = CreateObject("Scripting.FilesystemObject")

On Error Resume Next

Set MyRange = ActiveSheet.Range("A1:F" & NoF)
If MyRange Is Nothing Then Exit Sub
ActiveWorkbook.PublishObjects.Add _
(4, TempFile1, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True

Set MyRange = ActiveSheet.Range("G1")
ActiveWorkbook.PublishObjects.Add _
(4, TempFile2, MyRange.Parent.Name, MyRange.Address, 0, "", "").Publish True

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMsg = OutlookApp.CreateItem(0)
Set BodyText1 = FSO.OpenTextFile(TempFile1, 1)
Set BodyText2 = FSO.OpenTextFile(TempFile2, 1)

With OutlookMsg
.HTMLBody = BodyText1.ReadAll & BodyText2.ReadAll
.Subject = Range("A2").Text & " " & Range("A22").Text
.To = "raider@hotmail.com"
.CC = "raider@yahoo.com"
.Display
End With

Kill TempFile1
Kill TempFile2

Set BodyText2 = Nothing
Set BodyText1 = Nothing
Set OutlookMsg = Nothing
Set OutlookApp = Nothing
Set MyRange = Nothing
Set FSO = Nothing
End Sub
[/vb:1:ca498f1917]
 
Kodda bir sorun yok.

Muhtemel problemler;

1) F sütununda çok alt satırlarda boş dataların var, büyük ve boş bir tablo e-mail gövdesine ekleniyor. Çok altta kaldığı için göremiyorsun.

2) E-mail penceresini büyütürsen, belki görebilirsin.

3) Þu anda aklıma gelmeyen basit bir hata yapıyorsun.
 
Çalışan örnek bir dosya ektedir...
 
Geri
Üst