• DİKKAT

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

Makroyla email gonderme

[vb:1:528fea7be4]Sub sayfa_send()

ActiveSheet.Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:="c:\Part of " & ThisWorkbook.Name & " " & strdate

ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial xlPasteValues
ActiveSheet.Cells.ClearComments
ActiveSheet.Buttons.Delete
ActiveSheet.Range(Columns(71), Columns(256)).Delete

ActiveWorkbook.Save
ActiveWorkbook.SendMail "serdarguyuk@dianatravel.com.tr", "CAR HİRE"
fname = ActiveWorkbook.FullName
ActiveWorkbook.Close
Kill fname
End Sub[/vb:1:528fea7be4]
 
Öncelikle yazılan açıklamalar ve verilen bilgiler için teşekkür etmek istiyorum.Benzer bir sorun ile uğraşmaktayım ve buradan aldığım kodlar çok işime yaradı.Ancak şöyle bir sorunum var ki bir türlü işin içinden çıkamadım.Sanırım acemilikten olsa gerek :) Kullandığım dosya A1:H36 aralığını kapsıyor ve yaklaşık 50 farklı dosya var.Aslında hepsi şekil itibariyle aynı,sadece hücrelerdeki değerler farklı.Yani şablon olarak bir dosyaya uyarladığım taktirde hepsi için aynı şeyi kullanabilirim.Bir de küçük logo var ki bunu bir türlü mail gövdesine yerleştiremedim.Resim olarak yeri görünüyor ama boş bir çerçeveden ibaret.Bu konuda yardım edebilecek arkadaşlara şimdiden teşekkür ediyorum.
 
Sorunumu çözdüm teşekkürler
 
ben bu mailişini çakamadım yaw

Sub SendShByEmail()
Dim OutApp As Outlook.Application
Dim NewMail As Outlook.MailItem
Dim ShName As String, WbName As String
Dim i As Integer
Dim ModX As Object, VBComp As Object

ShName = ActiveSheet.Name
WbName = "C:\" & ShName & ".xls"

ThisWorkbook.SaveCopyAs WbName

Application.DisplayAlerts = False
Workbooks.Open WbName
For i = Sheets.Count To 1 Step -1
If ActiveWorkbook.Sheets(i).Name <> ShName Then Sheets(i).Delete
Next
....neyse uzatmayım



direk olarak başında ( Sub SendShByEmail() )
hata veriyor yollayamıyorum...
bi arkadaşım bunu halledip yollaması mümkünmü acaba.


outlook exprees 6 kullanıyorum
:kafa: :düsün:
 
ertan_bios' Alıntı:
ben bu mailişini çakamadım yaw
........

outlook exprees 6 kullanıyorum

Bu işi çakabilmeniz için biraz VBA bilmeniz gerekiyor yaw.

Kodlar Outlook Express için değil, MS Outlook için geçerlidir.
 
anlamadığım belli oldu dimi... :kafa:

öğretmen olmak isteyen varmı...
:?

bana biri geceden geceye ders verebilicek biri mesela...

merak varda 0 dan başlamak zor oluyor bana kafama vura vura :cekic:

bu vba'yı öğretecek biri varmı??????
 
Bugünlerde banada böyle bir şey lazım örnek dosya ekleyebilirseniz sevinirim.
saygılarımla
 
Arkada&#351;lar bi tane &#246;rnek eklemek &#231;ok mu zor?

Eklesenizde faydalansak olmaz m&#305;?

Bu bir sitem de&#287;il, sadece rica olarak anlay&#305;n l&#252;tfen...
 
Evet arkada&#351;lar acemiyim benim i&#231;inde faydal&#305; olur e&#287;er sizin i&#231;in zor olamayacaksa &#246;rnek dosyay&#305; eklerseniz seviniriz.
 
Excel dosyasını mail olarak atma uyarısız, outlook harici

Arkadaslar sitede araştırdım, buna benzer linkler var, özellikle Haluk hocama saygılarımı sunarım. Bizleri aydınlattığı için...
Aşağıdaki kodlar ile mail sunucunuz (Gmail örnekli) üzerinden dosyayı istediğiniz mail adresine atabiliyorsunuz. Üstelik Outlook üzerinden değil ve uyarı vermeden. Defalarca denendi. Sadece kendi ayarlarınızı yazmanızı öneririm. Office 2000 ve üstü gerektirir. Bunu bir butona atayabilirsiniz.
Ekli dosyayı indirip kullanabilirsiniz.


Private Sub CommandButton9_Click()
ActiveWorkbook.Save
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.name
FileExtStr = ""
wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "siz@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "kendisifreniz"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "gondereceginizkisi@example.com"
.CC = "gondereceginizkisi2@ornek.com"
.BCC = "gondereceginizkisi3@deneme.com"
.From = """Adınız Soyadınız"" <siz@gmail.com>"
.Subject = "Excel Yedek " & Format(Now, "dd-mm-yy- h-mm-ss")
.TextBody = Format(Now, "dd-mm-yy - h-mm-ss") & " Yedek alınmıştır."
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Quit
End Sub


Sanırım bir teşekkürü hak ediyorum. :D
 
Yap&#305;n&#305;n payla&#351;an&#305;n eline sa&#287;l&#305;k.
 
Son düzenleme:
g&#252;zel bir &#246;rnek olmu&#351; payla&#351;t&#305;&#287;&#305;n i&#231;in te&#351;ekk&#252;rler
 
Arkadaslar sitede araştırdım, buna benzer linkler var, özellikle Haluk hocama saygılarımı sunarım. Bizleri aydınlattığı için...
Aşağıdaki kodlar ile mail sunucunuz (Gmail örnekli) üzerinden dosyayı istediğiniz mail adresine atabiliyorsunuz. Üstelik Outlook üzerinden değil ve uyarı vermeden. Defalarca denendi. Sadece kendi ayarlarınızı yazmanızı öneririm. Office 2000 ve üstü gerektirir. Bunu bir butona atayabilirsiniz.
Ekli dosyayı indirip kullanabilirsiniz.


Private Sub CommandButton9_Click()
ActiveWorkbook.Save
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.name
FileExtStr = ""
wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "siz@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "kendisifreniz"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
With iMsg
Set .Configuration = iConf
.To = "gondereceginizkisi@example.com"
.CC = "gondereceginizkisi2@ornek.com"
.BCC = "gondereceginizkisi3@deneme.com"
.From = """Adınız Soyadınız"" <siz@gmail.com>"
.Subject = "Excel Yedek " & Format(Now, "dd-mm-yy- h-mm-ss")
.TextBody = Format(Now, "dd-mm-yy - h-mm-ss") & " Yedek alınmıştır."
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Quit
End Sub


Sanırım bir teşekkürü hak ediyorum. :D

kesinlikle hak ediyorsunuz.
size sonsuz teşekkürlerimi sunuyorum. sağolun :)
 
Merhabalar, Tüm topici dikaktlice okudum, çok güzel yazmışsınız fakat insan Visiual basic bilmeyin işin içinden çıkamıyor yaklaşık 2 gündür uğraşıyorum ama hazır olan kodları istediğim versiona çeviremedim.
Benim isteğim şu şekilde;
"A" Sütünunda İsim Soyisim
"B" Sütünunda Gönderilecek Mail Adresi
"C" Sütununda ise gönderilecek mail metni
bunu bir türlü başaramadım.
Eğer örnekli olarak ekleyebilirseniz çok memnun olacağım.
Elimde bir program var fakat isim soyisim olarak göndermiyor sadece mail adresini yazıp konuyu yazıp gönderiyor.
İsteğim
Sayın, Mete KALENDER (A1 hücresinden aldığı veri)
info@pixelmen.net (B1 hücresinden aldığı veri)
"Merhaba nasılsınız?" (c Sütünunundan aldığı veri. şeklinde.)
 
Merhabalar,

Tüm topici dikaktlice okudum, çok güzel yazmışsınız fakat insan Visiual basic bilmeyin işin içinden çıkamıyor yaklaşık 2 gündür uğraşıyorum ama hazır olan kodları istediğim versiona çeviremedim.
Benim isteğim şu şekilde;
"A" Sütünunda İsim Soyisim
"B" Sütünunda Gönderilecek Mail Adresi
"C" Sütununda ise gönderilecek mail metni
bunu bir türlü başaramadım.
Eğer örnekli olarak ekleyebilirseniz çok memnun olacağım.
Elimde bir program var fakat isim soyisim olarak göndermiyor sadece mail adresini yazıp konuyu yazıp gönderiyor.
İsteğim
Sayın, Mete KALENDER (A1 hücresinden aldığı veri)
info@pixelmen.net (B1 hücresinden aldığı veri)
"Merhaba nasılsınız?" (c Sütünunundan aldığı veri. şeklinde. 1 tane mail şablonunu olacak her bir satır için ayrı ayrı mail şablonu oluşmayacak.)

Sonuç olarak elimde bulunuan isim soyisim ve mail adreslerine bir şablonda yazılan metni göndermek istiyorum.
 
Geri
Üst