• DİKKAT

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

Soru Excel de bir sayfayı ekli Mail gönderme hakkında?

  • Konbuyu başlatan Konbuyu başlatan sefa044
  • Başlangıç tarihi Başlangıç tarihi
S

sefa044

Katılım
27 Eylül 2016
Mesajlar
60
Excel Vers. ve Dili
2010 tr
Arkadaşlar elimde böyle bir kod var. Sadece düz mail gönderiyor. ancak buna nasıl ek eklemeyi yaparız.
Çalışma kitabı içindeki "rapor" adlı sayfayı ayırıp farklı kaydedip bunu da maile ek olarak ekleyip karşıya göndermesini istiyorum.

Sub Excel_Gmail()
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "abcQgmail.com"
Flds.Item(schema & "sendpassword") = "12345"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update

With iMsg
.To = "adanalı@gmail.com"
.From = "Gönderen adı"
.Subject = "güncel rapor"
Set .Configuration = iConf
SendEmailGmail = .Send
End With

End Sub
 
Forumda "email gönderme" şeklinde "Ara" yaparsanız örneklerden yararlanabilirsiniz.
Ara
 
Bu kodu bir dene

Rich (BB code): 
Sub Excel_Gmail()


Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

uzanti = "." & fL.GetExtensionName(ThisWorkbook.FullName)
sat = fL.GetFolder(ThisWorkbook.Path).Files.Count + 1

dosya = ThisWorkbook.Path & "\rapor" & sat & uzanti
'ActiveSheet.Copy
Sheets("rapor").Copy

For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
If ModX.Type = 100 Then
VBComp.CodeModule.DeleteLines 1, VBComp.CodeModule.CountOfLines
Else
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
End If
Next

ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs dosya ', FileFormat:=xlExce12
ActiveWorkbook.Close False


Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "abcQgmail.com"
Flds.Item(schema & "sendpassword") = "12345"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update

Flds.Addattachment dosya

With iMsg
.To = "adanalı@gmail.com"
.From = "Gönderen adı"
.Subject = "güncel rapor"
Set .Configuration = iConf
SendEmailGmail = .Send
End With

End Sub
 
Halit hocam
ActiveWorkbook.SaveAs dosya ', FileFormat:=xlExce12
bu satırda hata verdi.
bide uzantısını xlsx olmasını istesem olur mu.
 
Birde bunu dene

Kod: 
Sub Excel_Gmail()

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
sat = fL.GetFolder(ThisWorkbook.Path).Files.Count + 1
dosya = ThisWorkbook.Path & "\rapor" & sat & ".xlsx"
'ActiveSheet.Copy
Sheets("rapor").Copy

ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs dosya, FileFormat:=51
ActiveWorkbook.Close False

Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
Flds.Item(schema & "sendusername") = "abcQgmail.com"
Flds.Item(schema & "sendpassword") = "12345"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update

Flds.Addattachment dosya

With iMsg
.To = "adanalı@gmail.com"
.From = "Gönderen adı"
.Subject = "güncel rapor"
Set .Configuration = iConf
SendEmailGmail = .Send
End With

End Sub
 
Flds.Addattachment dosya satırında
438 kodu hata: object doesnt support this property or methotd
verdi.
 
Sizin kendi kodlarınız maail gönderiyormuydu
 
birde bu kodu dene

Kod: 
Sub mailgonder()
'On Error Resume Next

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
sat = fL.GetFolder(ThisWorkbook.Path).Files.Count + 1
dosya = ThisWorkbook.Path & "\rapor" & sat & ".xlsx"
'ActiveSheet.Copy
Sheets("rapor").Copy

ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs dosya, FileFormat:=51
ActiveWorkbook.Close False

Set objEmail = CreateObject("CDO.Message")

kullanici_sahibi = "Gönderen adı"
kullanici_parola = "123456"

objEmail.From = kullanici_sahibi

objEmail.To = "adanalı@gmail.com"
objEmail.Subject = "güncel rapor"

objEmail.Addattachment dosya

With objEmail.Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = kullanici_sahibi
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = kullanici_parola
.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") = 455
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update

End With
objEmail.Send

MsgBox "işlem tamam.", vbApplicationModal, "Bilgilendirme!"



End Sub
 
halit3' Alıntı:
birde bu kodu dene

Kod: 
Sub mailgonder()
'On Error Resume Next

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
sat = fL.GetFolder(ThisWorkbook.Path).Files.Count + 1
dosya = ThisWorkbook.Path & "\rapor" & sat & ".xlsx"
'ActiveSheet.Copy
Sheets("rapor").Copy

ActiveSheet.DrawingObjects.Delete
ActiveWorkbook.SaveAs dosya, FileFormat:=51
ActiveWorkbook.Close False

Set objEmail = CreateObject("CDO.Message")

kullanici_sahibi = "Gönderen adı"
kullanici_parola = "123456"

objEmail.From = kullanici_sahibi

objEmail.To = "adanalı@gmail.com"
objEmail.Subject = "güncel rapor"

objEmail.Addattachment dosya

With objEmail.Configuration.Fields

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = kullanici_sahibi
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = kullanici_parola
.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") = 455
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update

End With
objEmail.Send

MsgBox "işlem tamam.", vbApplicationModal, "Bilgilendirme!"



End Sub
Genişletmek için tıkla ...
455 sunucu hatası veriyordu.465 yaptım.Hocam bu tamam çalıştı.ekli mail atıyor karşıya.ancak karşı taraf ekteki xlsx dosyasının açılmadığını söylüyor.
 
Son düzenleme:
Ne diyeceğimi bilemedim oluşturulan xlsx dosyasını siz açıyormusunuz.
karşı taraf ofisin hangi sürümünü kullanıyor onu da bilmek lazım xlsx uzantılı dosyayı ofis2003 de açılmaz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst