kaydete basılınca calısma kıtabı ıcınden bır sayfanın maıl atılması

[kneehot]

arkadaslar herkese kolay gelsın.sızden rıca ettıgım ekledıgım ornek ıcınde gumruk ozet yazılı sayfanın kaydet butonuna yada programdakı kaydet ıconuna basılınca (kayıt amaclı, maıl amaclı degıl) dosyada yapılan degısıklıklerı kaydederken N sutununa yazacagım maıl adreslerıne sadece gumruk ozet sayfasını maıl atması.ornek ıcındede anlattım.ılgılenırsenız cok sevınırım.tesekkurler.

 

[kneehot]

arkadaslar sanırım bıraz zor bır kod ıstedım.bende ararken asagıdakı gıbı bır kod buldum belkı yardımcı olabılır ayrıca eger hucrede yazan adreslere yollaması zor ıse asagıdakı gıbı koda ben yazabılırım adreslerı.bırtek fark var kadda text olarak gonderıyor ben excel dosyası olarak ve sayfada gorundugu gıbı gıtsın ıstıyorum.

Sub Mail_ActiveSheet_TXT_File()
Dim wb As Workbook
Dim strdate As String
Dim Fname As String
strdate = Format(Now, "dd-mm-yy h-mm-ss")
Fname = "C:\Part of " & ThisWorkbook.Name _
& " " & strdate & ".txt"
Application.ScreenUpdating = False
ActiveSheet.Copy
Set wb = ActiveWorkbook
With wb
.SaveAs Fname, FileFormat:=xlText
.SendMail "kubilay_karabulut@hotmail.com", _
"Bu mail excel uzerinden geliyor"
.Close False
End With
Kill Fname
Application.ScreenUpdating = True
End Sub

 

[kneehot]

arkadaslar gunaydın.sanırım gercekten zor bırsey ıstedım cunku bugune kadar ne sorunum varsa cozebılmıstım burdan aldıgım yardımlar ıle buseferkı sorum sanırım dişli cıktı kolaylastırmaya calısıyım olabılmesı ıcın cunku benım ıcın gercekten onemlı.bır oncekı msjımda maıl adreslerını kodun ıcıne ben gırebılırım demıstım bu sanırım ısı kolaylastırır.kaydederken gondersın demıstım onuda bır buton yapıp sadece maıl gonder secenegıne cevırebılırız gonderılcek sayfa ıcıne kayıt ısın dısında kalsın.excel formatı olması gerekmez pdf,jpg formatlarındada olabılır yollanan dosya.tek ıstedıgım sayfa gorundugu gıbı gıtsın.sızınde bır fıkrınız varsa paylasırsanız ve yardımcı olursanız cok sevınırım.

 

[hamitcan]

Size iki tane link vereyim. Burada konu işlenmiş, hatta örnekte verilmiş ama ben uğraşamadım, siz kendinize uyarlamaya çalışın.
http://www.vbaexpress.com/kb/getarticle.php?kb_id=880
http://www.vbaexpress.com/kb/getarticle.php?kb_id=326

 

[kneehot]

sayın hamitcan ılgınıze cok tesekkurler.verdıgınız adrese baktım fakat benım makrolar hakkında hıcbır bılgım yok kendıme uyarlamam ımkansız baktıgımda hıcbırsey anlamıyorum bos bır vaktınız olursa benım ıcın bıraz bakabılırsenız cok sevınırım ama gercekten zor bır ıs ıse tabıkı ugrasmayın.ılgınız ıcın tekrar tesekkur ederım.

 

[hamitcan]

Galiba yaptım. Kodları da aşağıdaki siteden elde ettim.
http://www.rondebruin.nl/sendmail.htm

Sub Mail_ActiveSheet_Outlook()
'You must add a reference to the Microsoft outlook Library
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim wb As Workbook
    Dim strdate As String
    strdate = Format(Now, "dd-mm-yy h-mm-ss")
    Application.ScreenUpdating = False
    For i = 3 To 7
       ActiveSheet.Copy
       Set wb = ActiveWorkbook

    With wb
        .SaveAs "Part of " & ThisWorkbook.Name _
              & " " & strdate & ".xls", xlExcel8
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)
        With OutMail
            .To = Cells(i, "n")
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add wb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    
    End With
        Next
    
    Application.ScreenUpdating = True
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[kneehot]

sayın hamitcan cok tesekkur ederim.bu yazdıgınız kodu konuyu acarken eklemıs oldugum ornekte konması gereken yere koyarsanız cok sevınırm.ben ugrastım ama beceremedım.ayrıca bu kaydet deyıncemı yollayacak yada bır butonmu eklemek gerek.buton eklenecekse onuda eklersenız benı cok mutlu edersınız dedıgım gıbı ben makrolardan hıc anlamadıgım ıcın herseyı sızden rıca edıyorum kusura bakmayın.

 

[hamitcan]

Eki inceleyin.

 

[kneehot]

sayın hamitcan gördügüm kadarıyla cok guzel olmus elınıze saglık fakat yolladıgı maılı acarken sıfre soruyor

 

[hamitcan]

Ben şifre koymadım. Ama kodda excel formatı belirtmişdim. Belki bundan kaynaklanıyordur. Kodları aşağıdaki ile değiştirip dener misiniz ?

Sub mail()
'You must add a reference to the Microsoft outlook Library
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim wb As Workbook
    Dim i As Integer
'    Dim strdate As String
'    strdate = Format(Now, "dd-mm-yy h-mm-ss")
    Application.ScreenUpdating = False
    For i = 3 To 7
       ActiveSheet.Copy
       Set wb = ActiveWorkbook

    With wb
        .SaveAs ActiveSheet.Name & ".xls"  '"Part of " & ThisWorkbook.Name _
              & " " & strdate & ".xls", xlExcel8
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)
        With OutMail
            .To = Cells(i, "n")
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = ActiveSheet.Name
            .Attachments.Add wb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    
    End With
        Next
    
    Application.ScreenUpdating = True
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

 

[kneehot]

Bu yeni kodla oldu cok tesekkur ederım gercekten yordum sızı tekrar cok tesekkurler.

 

[kneehot]

selamlar arkadaslar.actıgım bu konudan aldıgım yardım cok ısıme yaradı tekrar tesekkur edıyorum kucuk bır degısıklık yapılmasını ısteyecegım.dosyayı ekledım son halı ıle.ekledıgım dosyada butona basınca sadece o sayfayı gonderıyor.ıstedıgım degısıklık butona basınca sadece o sayfayı degıl butun dosyayı yollasın.ılgılenırsenız cok sevınırım.tesekkurler.

 

[hamitcan]

Linki inceleyin.
http://www.excel.web.tr/showthread.php?t=22959&highlight=aktif+dosyay%FD+mail+atma

 

[kneehot]

sayın hamitcan iyi aksamlar.verdiginiz link e baktım ama sanırım o outlook acıp gonderme yapıyor.sızın yazdıgınız kodda butona basınca tum dosyayı gonderme seklı ıle bır guncelleme yapmak mumkunmudur.

 

[hamitcan]

Sub OutlookMsgGönder()
Dim app As Outlook.Application
Dim posta As Outlook.MailItem
Dim MyFile As String

[b][color=red]ActiveWorkbook.Save[/b][/color]
MyFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

Set app = CreateObject("Outlook.Application")
Set posta = app.CreateItem(olMailItem)
    With posta
      .To = "xxx@yyy.com;zzz@bbb.com"
      .CC = "ggg@ffgghh.com"
      '.BCC =
      .Subject = Date & " Günlük Rapor"
      .Body = "Merhaba" & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Date & " tarihli rapor ektedir" & Chr(13) & Chr(13) & Chr(13) & "İyi Çalışmalar."
      .Attachments.Add MyFile
     [b][COLOR=RED]'.Display[/COLOR][/b]'Bu satırı kapatıp
      [COLOR=RED][B].Send [/COLOR][/B] 'bu satırı açın.
    End With
Application.DisplayAlerts = True

Set app = Nothing
Set posta = Nothing
'**********************************************************************
'Referanslardan Microsoft Outlook X.X Object Library seçili olmalıdır.*
'**********************************************************************
End Sub

 

[kneehot]

sayın hamitcan tesekkurler.sizden son birsey isteyecegim.yukarıdakı kodda dosyanın son kayıtlı seklını yolluyor ama dosyayı acıp ıcınde degısıklık yaptıktan sonra gonder deyınce yapılan degısıklıkler gıden dosyaya yansımıyor.once kaydet deyıp sonra gondermek gerek.dosyayı bırtek ben kullanacak olsam hıc problem degıl ama hazırladıgım dosyayı 8 kısı kullanacak ve herseferınde kaydet degıp yollama seklını yerıne getırmeyı unutabılırler.bu rıskı ortadan kaldırmak adına yapılan degısıklıklerle yollamasını saglarsanız cok sevınırım.

 

[hamitcan]

Verdiğim çözümde o da var aslında. Kodu biraz incelemeniz yeterliydi. Yukarıda kodda bir kırmızı renkli satırlara dikkat ediniz.

 

[kneehot]

sayın hamitcan kusura bakmayın bu ısten hıc anlamadıgım ıcın gorememısım.yardımlarınız ve sabrınız ıcın cok tesekkur ederım gercekten cok yardımcı oldunuz bana sagolun.

 

[yeterbaa]

Ya bişi sorucam sizin dosyayı açınca çalışıyor. ben kendi dosyama kodları ekleyince Dim app ile paşlayan satır için "Compile error: User-defined type not defined" hatası veriyor. nerede eksik yapıyorum? Yardımcı olurmusunuz

 

[yeterbaa]

Çözdüm gerek kalmadı Aynı hata ile karşılaşan arkadaşlar tanımlama satırlarını sildiğinizde çalışıyor