• DİKKAT

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

Makroyla email gonderme

Bunu deneyin. Size aktif sayfayı HTML'e çevirecek kodları göndermemişim.Kendim denedim çalışıyor. Bu sefer problem olmaması lazım. Ayrıca bunları Sn.Alpen'in verdiği http://www.rondebruin.nl sitesinden almıştım. orayı bir ziyaret ederseniz farklı şeyler olduğunu göreceksiniz. Kolay gelsin.

Private Sub CommandButton2_Click()

Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)
With NewMail
.To = "falan@hotmail.com"
.Subject = .Subject = [a2]
.HTMLBody = SheetToHTML(ActiveSheet)
.Save
.Send
End With
Set NewMail = Nothing
Set OutApp = Nothing
End Sub


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
 
Re: anladım ki, be tam bir excel acemisiymişim :(

turkanet' Alıntı:
hepsini uyguladım ve şekildeki hata mesajını verdi :(
Genişletmek için tıkla ...

:mrgreen: vermesi normal çünkü excel'in sheettohtml diye bir yerleşik fonksiyonu yok.

aşağıdaki 2 fonksiyondan (sheettohtml, rangetohtml) işinize yarayanı kopyalayın.


[vb:1:8aac53d148]Public Function SheetToHTML(sh As Worksheet)

Dim TempFile As String
Dim fso As Object
Dim ts As Object

Randomize

sh.Copy
TempFile = sh.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) & ".htm"

ActiveWorkbook.SaveAs TempFile, xlHtml
ActiveWorkbook.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
Kill TempFile

End Function [/vb:1:8aac53d148]

[vb:1:8aac53d148]Function RangetoHTML(Rng As Range)

Dim wb As Workbook
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim i As Long
Dim Rng2 As Range
Dim DelCol1 As String
Dim DelCol2 As String

Randomize

TempFile = Rng.Parent.Parent.Path & "\TmpHTML" & Int(Rnd() * 10) & ".htm"

'Copy the sheet to a new workbook and copy the cells to avoid the
'255 character limit when copying sheets
Rng.Parent.Copy
Rng.Parent.Cells.Copy ActiveSheet.Cells

Set wb = ActiveWorkbook
Set Rng2 = wb.Sheets(1).Range(Rng.Address)

'Convert to values
Rng2.Copy
Rng2.PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Delete rows below
Rng2.Parent.Rows(Rng2.Rows(Rng2.Rows.Count).Row + 1 & ":65536").Delete

'Delete columns to right
DelCol2 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns _
(Rng2.Columns.Count).Column + 1).Column)
Rng2.Parent.Columns(DelCol2 & ":IV").Delete

'Delete rows above
If Rng2.Rows(1).Row > 1 Then
Rng2.Parent.Rows("1:" & Rng2.Rows(1).Row - 1).Delete
End If

'Delete columns to left
If Rng2.Columns(1).Column > 1 Then
DelCol1 = Chr(64 + Rng2.Parent.Columns(Rng2.Columns(1).Column - 1).Column)
Rng2.Parent.Columns("A:" & DelCol1).Delete
End If

wb.SaveAs TempFile, xlHtml
wb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.ReadAll

ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile

End Function
[/vb:1:8aac53d148]
 
:mrgreen: birinçi ben yazdım, sevgili Alpen sizin yazdığınız sayılmaz....
 
Hiç önemli değil sizinki sayılmaz diye zaten tekzip etmiştim :mutlu:
 
sn arkadaşlar;

Sub Mail_Workbook_2()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wbname As String
Application.ScreenUpdating = False
Sheets(1).Range("A1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Password = ""

Set wb1 = ActiveWorkbook
wbname = "C:/" & _
Format(Now, "dd.mm.yyyy") & ".xls"
wb1.SaveCopyAs wbname

Set wb2 = Workbooks.Open(wbname)
With wb2
.SendMail "falanfilan@hotmail.com", _
Format(Now, "dd.mm.yyyy")
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
Application.ScreenUpdating = True
End Sub

YUKARIDAKİ KODU BİR BUTONA BAÐLAYAMADIM BİR TÜRLÜ. BUTONA BASINCA HİÇBİR ÞEY OLMUYOR. AMA KODU VB İÇİNDEN ÇALIÞTIRINCA OLUYOR. BU DEFA DA ÇALIÞMA KİTABININ TAMAMINI YOLLUYOR. BEN SADECE O SAYFANIN ATTACHMENT OLARAK GİTMESİNİ VE DE SUBJECT'İN BUGÜNKÜ TARİH OLARAK KALMASINI İSTİYORUM (BU KODDA VAR ZATEN).
DOSYA EKTEDİR.

TEÞEKKÜRLER
 
sevgili arkadaşlar, bu konuda yardıma çok ihtiyacım var, ilgilenen arkadaşlara teşekkürler. cevaplarınızı bekliyorum
 
Deneyin ...
 
sn Raider; ilginize teşekkürler, düzeltmeniz ile -bir şey hariç- olmuş.
eksik olan şu; kitabın tamamını yolluyor. ben ise sadece butonun bulunduğu sayfayı yollamasını istiyorum. çünkü alıcının diğer sayfaları görmesi uygun değil.
bunun için nasıl bir değişiklik yapılmalı?
teşekkürler
 
Ekteki dosyayi bir deneyin ...
 
turkanet,

O kadar ısrarla cevap bekliyordunuz.

Son gönderdiğimi denediniz mi, sonuç ne oldu ??
 
Sn. raider, cevabı aldığım andan beri dosyayı uygulamaya çalışıyorum. modmail olayını import-export yaparak kendi belgeme alabildim. başka bir yöntem bilmiyordum. ayrıca, istediğim şey olmuş, minnettarım size...
fakat;
çok önemli bir sorun çıktı:
belgenin yolladığım sayfası, diğer sayfalardan veri alıyor. ve gördüğüm kadarıyla, bu metod, diğer sayfaları geçici olarak yok ediyor sonra tekrar getiriyor. ama yollarken tek sayfa yolladığı için, hücre referansları da yok edildiği için, tüm dolu hücrelerin içi !BAÞVURU olarak yollanıyor.
bu durum için ne yapmalıyım?
teşekkürler
 
Yani, gönderilen sayfadaki hücrelerde yer alan formullerin, hucre değerleri ile değiştirilmesini mi istiyorsunuz ?
 
Son olarak, bir de ekteki dosyayı deneyin ...
 
Bu forumun ödül alması gereken naçizane şahsiyetlerinden birisiniz...
minnettarım, ve bilginizin önünde saygıyla eğiliyorum.

bu kadar lafa ne gerek var demeyin, dün genel müdür öğlen saatlerinde ofisi ziyaret edip, "bana yolladığın tabloyu body olarak değil, attachment olarak yolla" dediğinde elim-ayağıma dolanmıştı. çünkü daha önce excel'in eposta düğmesine (araç çubuğundaki) basıp yolluyordum. 2 seçenek çıkardı 1-body olarak, 2 tüm kitap attach olarak yolla. bugün aldığım talimata ikisi de uymuyordu ve yarın sabaha rapor gitmeliydi ve hata olmamalıydı. işte hikaye bu.

başarılarınızın devamını dilerim.
teşekkürler...
:bravo: :bravo: :bravo: :bravo: :bravo: :bravo: :bravo: :bravo: :bravo:
 
SON BİR NOKTA;
gizli bir kopyası da bana gelsin istiyorum (Bcc sanırım), kodun neresine ne eklemeliyim?
teşekkürler
 
Bu kodla maalesef olmaz.
 
PEKİ, KODU AYNEN KOPYALAYIP DEVAMINA YAPIÞTIRIP, 2. KOPYASINA DA KENDİ EMAİL ADRESİMİ YAZSAM??? :?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst