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

[sefa044]

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

 

[turist]

Forumda "email gönderme" şeklinde "Ara" yaparsanız örneklerden yararlanabilirsiniz.
Ara

 

[sefa044]

Forumda "email gönderme" şeklinde "Ara" yaparsanız örneklerden yararlanabilirsiniz.
Ara

Baktım ancak. Tamda istediğim şekilde bir yanıt bulamadım.
Ustadlardan yardım bekliyorum

 

[halit3]

Bu kodu bir dene

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

 

[sefa044]

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

 

[halit3]

Birde bunu dene

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

 

[sefa044]

Flds.Addattachment dosya satırında
438 kodu hata: object doesnt support this property or methotd
verdi.

 

[halit3]

Sizin kendi kodlarınız maail gönderiyormuydu

 

[halit3]

birde bu kodu dene

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

 

[sefa044]

birde bu kodu dene

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

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.

 

[halit3]

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.