Excel & Outlook

mixser · 23 Ocak 2008

Merhaba arkadaşlar

başlıktanda anlaşılacağı gibi konu excelden mail atmak. Evet bu konuyu formda aradım ve buldum ve aşağıda kodu uyguladım. Sonuç umduğum gibi oldu excel sayfam başka bir kitap olarak kayıt ediliyor ve atacağım maile ekleniyor.
buraya kadar sorun görülmüyor. Yapmak istediğim ise
1-) sayfanın tamamını değil belirlediğim yazdırma alanını göndermek istiyorum.
2-) sayfadaki formüllerin yeni oluşturulan dosyaya kopyalanmasını istemiyorum sadece biçimler ve değerler kopyalansın
3-) yeni oluşturulan dosya adını belirlediğim bir hücreden alsın

bu konuyla alakalı olan 8 sayfalık bölümü okurken inanın bu soruyu sormaya çakindim ama inanın bu şekilde bi örnek olmadığı için sormak gereği duydum.

uyguladığım kod aşağıda

'vb:1:a87fbdb470]'************************************************* *****
'* Sadece Aktif sayfayı MS Outlook ile yollamak için *
'* yapılmış bir çalışmadır *
'* Micosoft Outlook X.0 referansı eklenmelidir ! *
'* Burası Excel vadisi ... *
'* Raider Â® *
'* Ãubat 2005 *
'************************************************* *****

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:\DENEME\" & 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

On Error Resume Next
For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
Next
On Error GoTo 0
Application.DisplayAlerts = True

ActiveWorkbook.Close SaveChanges:=True

Set OutApp = New Outlook.Application
Set NewMail = CreateItem(olMailItem)
With NewMail
.To = ""
.Subject = ""
.Body = "Bu e-maili aldıysanız sorun yok demektir."
.Attachments.Add WbName
.Display
End With
Set NewMail = Nothing
[/vb:1:6b755bdaa3]

End Sub

Korhan Ayhan · 24 Ocak 2008

Selamlar,

Sn. Haluk beye ait kodu aşağıdaki şekilde revize ettim. Uygulayıp denermisiniz.

Kod:

Sub AKT&#304;F_SAYFADA_SE&#199;&#304;L&#304;_ALANI_MA&#304;L_AT()
    Application.ScreenUpdating = False
    Dim OutApp As Outlook.Application
    Dim NewMail As Outlook.MailItem
    Dim Dosya_Ad&#305; As String, Sayfa_Ad&#305; As String
    Dim Alan As String, Mail_Dosyas&#305; As String
    
    Dosya_Ad&#305; = ThisWorkbook.Name
    Sayfa_Ad&#305; = ActiveSheet.Name
    Alan = Selection.Address
    Workbooks.Add (xlWBATWorksheet)
    Mail_Dosyas&#305; = Sayfa_Ad&#305; & ".xls"
    ActiveSheet.Name = Sayfa_Ad&#305;
    Range(Alan).Value = Workbooks(Dosya_Ad&#305;).Sheets(Sayfa_Ad&#305;).Range(Alan).Value
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\User\Desktop\" & Sayfa_Ad&#305; & ".xls", _
    FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
    
    Set OutApp = New Outlook.Application
    Set NewMail = CreateItem(olMailItem)
    With NewMail
    .To = ""
    .Subject = ""
    .Body = "Bu e-maili ald&#305;ysan&#305;z sorun yok demektir."
    .Attachments.Add Mail_Dosyas&#305;
    .Display
    End With
    Set OutApp = Nothing
    Set NewMail = Nothing
End Sub

ANTALYA 01 · 24 Ocak 2008

Z

Merhaba
Exel 2003 Kullanıyorum bu kodları denediğimde ekteki hatayı veriyor.Bu konuyla bende ilgileniyorum tşk.

Korhan Ayhan · 25 Ocak 2008

Selamlar,

Hata mesajını ilgili referansı aktif hale getirmediğiniz için alıyorsunuz. Aşağıdaki işlemleri uygulayın ve daha sonra kodu çalıştırın.

1- ALT+F11 tuşlarına basıp kod editörünü açın.
2- Tool-References menüsünü açın.
3- Açılan pencerede Microsoft Outlook XX.X Object Library seçeneğini aktif hale getirip tamam tuşuna basın. Dosyayı kapatıp tekrar açın ve kodu çalıştırın.

hussain · 25 Ocak 2008

program icin tesekkurler

mixser · 25 Ocak 2008

Merhaba Sn. Cost_Control

Kod için teşekkür edemedim kusura bakma hala uygulama yapamadım çok yoğunluk var. Anladığım kadarıyla sn.hussain bunu başarmış en azından onun adına sevindim en kısa zamanda denememi yapıp bütün şablonlarıma uyğulayacağım. Ellerine sağlık sağolasın

baydeniro · 10 Ağustos 2009

Merhaba. Kodları aşağıdaki gibi kendime uyarladım. Ancak mail gönderildi mesajı vermesine rağmen mesaj gitmiyor. Uyarlamada nasıl bir hata yapmış olabilirim acaba ?

Sub Mail_Yolla()
If evlilik = 1 Then
dosya = "c:\Araba.xls"
baslik = "Mutlu Yillar"
End If
If dogum = 1 Then
dosya = "c:\Araba.xls"
baslik = "Uzun ve mutlu bir omur dileklerimle"
End If

On Error Resume Next
Dim tanimla, ayarla As Object, referans
Set tanimla = CreateObject("CDO.Message")
Set ayarla = CreateObject("CDO.Configuration")
ayarla.Load -1
Set referans = ayarla.Fields
With referans
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "serdar.okan@hotmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "<12345678>"
.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 tanimla
Set .configuration = ayarla
.To = "serdar.okan@yahoo.com"
.CC = """"
.BCC = """"
.From = " <serdar.okan@hotmail.com>"
.Subject = baslik
.TextBody = mesajimiz
.Send
End With
If Err.Number = -1939636883 Then
MsgBox "Lutfen Firewall ayarlarinizi kontrol ediniz", vbExclamation, "Mail Gonderilemedi"
Exit Sub
End If
MsgBox " E-postanız gonderildi", vbInformation, "serdar.okan@gmail.com"
End Sub

Excel & Outlook

mixser

Korhan Ayhan

Administrator

ANTALYA 01

Korhan Ayhan

Administrator

hussain

mixser

baydeniro