Buton İle Mail Atmak Nasıl Yapılır ??

ozgurpeh · 30 Ekim 2007

Arkadaşlar Merhaba;

Sitede ki mail gönderme hakkındaki konuların hepsine baktım fakat bir türlü istediğim bilgiye ulaşamadım muhtemelen örnek olmamasından dolayı, Ekte yolladığım örnek üzerinde sayfa1 e bir buton koyarak sayfa3 ü sayfa1 e farklı bir buton koyarak ta sayfa4 ü mail olarak nasıl atablirim örnek üzerindne yardımcı olursunanız sevinir. Yardılarınız için şimdiden teşekür ederim.

ozgurpeh · 30 Ekim 2007

Yok mu bana yardım edecek ?? bu benim için çok önemli bildiğinizbirşeyler varsa lütfen

Recep İpek · 30 Ekim 2007

Biraz acele etmiyormusunuz? Daha sorunuzu soralı 47 dakika olmuş.

Bu saatlerde çoğu arkadaşlarımız offline olduğu için cevap yazacak arkadaş bulamayabilirsiniz.

Recep İpek · 31 Ekim 2007

Aşağıdaki linki inceleyebilirsiniz.

http://www.dicks-clicks.com/excel/olSending.htm#Sending_One_Sheet_as_an_Attachment

ozgurpeh · 31 Ekim 2007

Ripek' Alıntı:
Aşağıdaki linki inceleyebilirsiniz.

http://www.dicks-clicks.com/excel/olSending.htm#Sending_One_Sheet_as_an_Attachment

Yardımınız için teşekür ederim fakat benim sıkıntım modülü butonla nasıl birleştiricem command butondan deniyorum olmuyo nasyapmam gerek bu işlemi

Recep İpek · 31 Ekim 2007

Aşağıdaki kodları deneyiniz.

Kod:

Sub SendOneSheet()
    Dim olApp As Outlook.Application
    Dim olMail As MailItem
    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)
    ThisWorkbook.Sheets("Sayfa4").Copy 'Sayfa adını kendinize göre uyarlayınız
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Sayfa4.xls"
    With olMail
        .To = "[EMAIL="xxx@yyy.com"]xxx@yyy.com[/EMAIL]"
        .Subject = "Sayfa 4"
        '.BCC = "[EMAIL="ttt@yyy.com"]ttt@yyy.com[/EMAIL]"
        .Body = "Merhaba" & Chr(10) & Chr(10) & "Dosya ektedir." & Chr(13) & Chr(13) & "İyi Çalışmalar."
        .Attachments.Add ActiveWorkbook.FullName
        .Display
        '.Send
    End With
    ActiveWorkbook.Close False
    Kill ThisWorkbook.Path & "\" & "Sayfa4.xls"
    Set olMail = Nothing
    Set olApp = Nothing
'*******************************************************************
'Referanslardan Microsoft Outlook X.X Object Library seçili olmalı.*
'*******************************************************************
End Sub

ozgurpeh · 31 Ekim 2007

Ripek' Alıntı:

Aşağıdaki kodları deneyiniz.

Kod:

Sub SendOneSheet()
    Dim olApp As Outlook.Application
    Dim olMail As MailItem
    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)
    ThisWorkbook.Sheets("Sayfa4").Copy 'Sayfa adını kendinize göre uyarlayınız
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Sayfa4.xls"
    With olMail
        .To = "[EMAIL="xxx@yyy.com"]xxx@yyy.com[/EMAIL]"
        .Subject = "Sayfa 4"
        '.BCC = "[EMAIL="ttt@yyy.com"]ttt@yyy.com[/EMAIL]"
        .Body = "Merhaba" & Chr(10) & Chr(10) & "Dosya ektedir." & Chr(13) & Chr(13) & "İyi Çalışmalar."
        .Attachments.Add ActiveWorkbook.FullName
        .Display
        '.Send
    End With
    ActiveWorkbook.Close False
    Kill ThisWorkbook.Path & "\" & "Sayfa4.xls"
    Set olMail = Nothing
    Set olApp = Nothing
'*******************************************************************
'Referanslardan Microsoft Outlook X.X Object Library seçili olmalı.*
'*******************************************************************
End Sub

Çok Teşekür ederim Tam istediğim gibi ama o butonları nasıl ekliyosun oraya VBA modüle bakıyorum sayfa4 e uyarlı ama sayfa2 de gidiyo

) ya bunu biraz açıklarmısın nasıl yapılıyor

Recep İpek · 31 Ekim 2007

Excel sayfasında menülerin sağındaki boşlukta sağ klik yapıp,"Forms" araç kutusunu aktif hale getirin.

Buradaki buton işaretini tutarak sayfaya doğru sürekleyiniz.

ozgurpeh · 31 Ekim 2007

Ripek' Alıntı:
Excel sayfasında menülerin sağındaki boşlukta sağ klik yapıp,"Forms" araç kutusunu aktif hale getirin.

Buradaki buton işaretini tutarak sayfaya doğru sürekleyiniz.

Çok Teşekür Ederim Yarmınız için

ozsah · 19 Mart 2008

AŞAĞIDAKİ KOD MAİL ATIP SAVE EDİYOR. FAKAT DOSYA BÜYÜK YAKIN ZAMANDA MAİL ATAMAYCAK. MAİLİ ATARKEN ZİP DOSYASI YAPIP ÖYLE GÖNDERMESİ İÇİN KODA NASIL BİR EK YAPILMALI ???

Sub mail_at()
ActiveWorkbook.Save
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
msgbox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.Name
FileExtStr = ""
wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail adresi@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "şifre"
.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 iMsg
Set .Configuration = iConf
.To = "********"
.CC = ""
.BCC = ""
.From = """Ali Veli"" <***@gmail.com>"
.Subject = "Ali Veli" & Format(Now, "dd-mm-yy- h-mm-ss")
.TextBody = Format(Now, "dd-mm-yy - h-mm-ss") & " Yedek alınmıştır."
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Quit
End Sub

ozsah · 25 Mart 2008

Bu zipli mail atabilecek hale getirebilecek arkadaşım varmı ?? ilginizi rica ederim.

Sub mail_at()
ActiveWorkbook.Save
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
msgbox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = wb.Name
FileExtStr = ""
wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail adresi@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "şifre"
.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 iMsg
Set .Configuration = iConf
.To = "********"
.CC = ""
.BCC = ""
.From = """Ali Veli"" <***@gmail.com>"
.Subject = "Ali Veli" & Format(Now, "dd-mm-yy- h-mm-ss")
.TextBody = Format(Now, "dd-mm-yy - h-mm-ss") & " Yedek alınmıştır."
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.Quit
End Sub

Zeki Gürsoy · 25 Mart 2008

zip değilde rar isterseniz, aşağıdaki gibi kullanabilirsiniz..

Kod:

Sub CDO_Mail()
Dim CDO_msg  As Object
Dim CDO_conf As Object

BackUpFile_XLS$ = "C:\" & Format$(Date, "yyyymmdd") & _
                "_" & Format$(Time, "hhmmss") & ".xls"

BackUpFile_RAR$ = Left$(BackUpFile_XLS, Len(BackUpFile_XLS) - 4) & ".rar"
                
ThisWorkbook.SaveCopyAs BackUpFile_XLS
'RAR s&#305;k&#305;&#351;t&#305;rma
Shell Environ$("ProgramFiles") & "\Winrar\rar.exe " & _
    " M -ep " & Chr(34) & BackUpFile_RAR & _
                Chr(34) & " " & Chr(34) & BackUpFile_XLS & Chr(34)
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Set CDO_msg = CreateObject("CDO.Message")
Set CDO_conf = CreateObject("CDO.Configuration")

With CDO_conf
.Fields.Item( _
    "http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Fields.Item( _
    "http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields.Item( _
    "http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Fields.Item( _
    "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Fields.Item( _
    "http://schemas.microsoft.com/cdo/configuration/sendusername") = "***@gmail.com"
.Fields.Item( _
    "http://schemas.microsoft.com/cdo/configuration/sendpassword") = "&#351;ifre"
.Fields.Item( _
    "http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 '465
.Fields.Item( _
    "urn:schemas:httpmail:priority") = 1
.Fields.Item( _
    "urn:schemas:httpmail:importance") = 2
.Fields.Update
End With

With CDO_msg
Set .Configuration = CDO_conf
.To = "***@hotmail.com"
.From = "Ad&#305;n&#305;z <***@gmail.com>"
.Subject = "Yedek"
.TextBody = "Yedek dosya ektedir..."
.AddAttachment BackUpFile_RAR
.Send
End With

Set CDO_msg = Nothing
Set CDO_conf = Nothing

Kill BackUpFile_RAR
End Sub

fkalelinet · 30 Ekim 2014

konu çok eski ve portlarda değişti. güncel bir kod sitede de bulunması adına.

bi program var kullanıyorum sadece winrar ı uygulayamadım. birçok sitede örnekler var ancak hepsi eski yada güncel değil ve ofis 2013 de kodlar çalışmıyor yada ben çalıştıramadım.

belirttiğim klasördeki tüm dosyaları rar ile sıkıştırıp göndermek istiyorum. dosyanın kendisi de bu klasörün içerisinde dosya açıkken bunu yapma şansım nedir?. yada bu dosya hariç diğerlerini göndermek şansım mesela.

Buton İle Mail Atmak Nasıl Yapılır ??

ozgurpeh

ozgurpeh

Recep İpek

Recep İpek

ozgurpeh

Recep İpek

ozgurpeh

Recep İpek

ozgurpeh

ozsah

ozsah

Zeki Gürsoy

Uzman

fkalelinet

Ekli dosyalar