• DİKKAT

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

e-mail sorunu ??

ozgurpeh

Altın Üye
Katılım
30 Eylül 2007
Mesajlar
383
Excel Vers. ve Dili
2010 Türkçe
Sub SendOneSheet()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
ThisWorkbook.Sheets("RP").Copy 'Sayfa adını kendinize göre uyarlayınız
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "STOK RAPORU.xls"
With olMail
.To = "falanfilan@filan.com.tr"
.CC = "sfs@sdfs.com"
.Subject = "STOK RAPORU"
'.BCC = "ttt@yyy.com"
.Body = "Merhaba;" & Chr(10) & Chr(10) & "Günlük Rapor Dosyası Güncellenmiştir." & Chr(13) & Chr(13) & "İyi Çalışmalar.."
.Attachments.Add ActiveWorkbook.FullName
.Display
'.Send
End With
ActiveWorkbook.Close False
Kill ThisWorkbook.Path & "\" & "STOK RAPORU.xls"
Set olMail = Nothing
Set olApp = Nothing

End Sub


Arkadaşlar, bu yöntemle çalışmamdan sadece 1 sayfayı mail olarak atabiliyorum 1 sayfa daha eklemek yani ayrı ayrı 2 sayfa yollamak için nasıl değişiklik yapmalıyım
 
Merhabalar

Muhtemelen başka yöntemler de kullanılarak çözülebilir ama en basit haliyle;
Kod:
ThisWorkbook.[COLOR=red][B]Sheets("RP")[/B][/COLOR].Copy 'Sayfa adını kendinize göre uyarlayınız
satırını,
Kod:
ThisWorkbook.[B][COLOR=red]Sheets(Array("RP", "RP1"))[/COLOR][/B].Copy
şeklinde değiştirebilirsiniz.
 
Merhabalar

Muhtemelen başka yöntemler de kullanılarak çözülebilir ama en basit haliyle;
Kod:
ThisWorkbook.[COLOR=red][B]Sheets("RP")[/B][/COLOR].Copy 'Sayfa adını kendinize göre uyarlayınız
satırını,
Kod:
ThisWorkbook.[B][COLOR=red]Sheets(Array("RP", "RP1"))[/COLOR][/B].Copy
şeklinde değiştirebilirsiniz.

Bu şekilde yapıldığında tek excel çalışması 2 sayfa olarak ekleniyor outloka. Oysa ben ayrı ayrı iki farklı çalışma sayfası eklensin istiyorum
 
Merhabalar,

Aşağıdakini deneyin.
Kod:
Sub SendOneSheet()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim wb1 As Workbook, wb2 As Workbook
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
On Error Resume Next
Application.EnableEvents = False
ThisWorkbook.Sheets("RP").Copy 'Sayfa adını kendinize göre uyarlayınız
Set wb1 = ActiveWorkbook
ThisWorkbook.Sheets("RP2").Copy
Set wb2 = ActiveWorkbook
wb1.SaveAs ThisWorkbook.Path & "\" & "STOK RAPORU.xls"
wb2.SaveAs ThisWorkbook.Path & "\" & "STOK RAPORU2.xls"
Application.EnableEvents = True
With olMail
   .To = "[EMAIL="falanfilan@filan.com.tr"]falanfilan@filan.com.tr[/EMAIL]"
   .CC = "[EMAIL="sfs@sdfs.com"]sfs@sdfs.com[/EMAIL]"
   .Subject = "STOK RAPORU"
  '.BCC = "[EMAIL="ttt@yyy.com"]ttt@yyy.com[/EMAIL]"
   .Body = "Merhaba;" & Chr(10) & Chr(10) & "Günlük Rapor Dosyası Güncellenmiştir." & Chr(13) & Chr(13) & "İyi Çalışmalar.."
   .Attachments.Add wb1.FullName
   .Attachments.Add wb2.FullName
   .Display
  '.Send
End With
wb1.Close False
wb2.Close False
Kill ThisWorkbook.Path & "\" & "STOK RAPORU.xls"
Kill ThisWorkbook.Path & "\" & "STOK RAPORU2.xls"
Set wb1 = Nothing
Set wb2 = Nothing
Set olMail = Nothing
Set olApp = Nothing
End Sub
 
Merhabalar,

Aşağıdakini deneyin.
Kod:
Sub SendOneSheet()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim wb1 As Workbook, wb2 As Workbook
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
On Error Resume Next
Application.EnableEvents = False
ThisWorkbook.Sheets("RP").Copy 'Sayfa adını kendinize göre uyarlayınız
Set wb1 = ActiveWorkbook
ThisWorkbook.Sheets("RP2").Copy
Set wb2 = ActiveWorkbook
wb1.SaveAs ThisWorkbook.Path & "\" & "STOK RAPORU.xls"
wb2.SaveAs ThisWorkbook.Path & "\" & "STOK RAPORU2.xls"
Application.EnableEvents = True
With olMail
   .To = "[EMAIL="falanfilan@filan.com.tr"]falanfilan@filan.com.tr[/EMAIL]"
   .CC = "[EMAIL="sfs@sdfs.com"]sfs@sdfs.com[/EMAIL]"
   .Subject = "STOK RAPORU"
  '.BCC = "[EMAIL="ttt@yyy.com"]ttt@yyy.com[/EMAIL]"
   .Body = "Merhaba;" & Chr(10) & Chr(10) & "Günlük Rapor Dosyası Güncellenmiştir." & Chr(13) & Chr(13) & "İyi Çalışmalar.."
   .Attachments.Add wb1.FullName
   .Attachments.Add wb2.FullName
   .Display
  '.Send
End With
wb1.Close False
wb2.Close False
Kill ThisWorkbook.Path & "\" & "STOK RAPORU.xls"
Kill ThisWorkbook.Path & "\" & "STOK RAPORU2.xls"
Set wb1 = Nothing
Set wb2 = Nothing
Set olMail = Nothing
Set olApp = Nothing
End Sub

Teşekürler Çok Saol
 
Geri
Üst