• DİKKAT

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

Mail gönderme

  • Konbuyu başlatan Konbuyu başlatan halit3
  • Başlangıç tarihi Başlangıç tarihi
Mail gönderme ile ilgili çalışmamı ekliyorum hayırlı olur inşallah.
Proğram ile ilgili açıklama sayfa2 de mevcut

Açıklama

Yardım sayfası

kişilerin adını soyadını A sütünuna yazın
B sütununu boş bırakın
C sütununa mail adreslerini yazın
E2 hücresine göndereceğiniz maile ait konuyu yazın
H2:H8 hücresi arasına mesajlarınızı yazın
Nesneleri sil düğmesine tıklayın
Nesne ekle düğmesine tıklayın
Mail göndereceğiniz kişilere ait seçenek düğmelerinden seçin veya hepsini seç düğmesine tıklayın seçimi yapılmayan mailleri gönderme işlemini yapmıyor.
Mail gönder düğmesine tıklayın
Mail göndereceğiniz adresleri kod otomatik olarak D2 hücresine aktarmaktadır.



Uyarı

ofis 2003 de mail gönderimi yapıyor ama uyarı mesajına evet demek gerekiyor.
ama ofis 2007 de mail gidiyor.

Microsoft Office Outlook 2007 de mail adresi olarak hotmail adresimi kuramadım sistem bir şekilde aktif olmuyor
ama gmail hesabımı kurdum.

yani anlıyacağınız hotmail hesabı bu kurulumda çalışmıyor gmail hesabı çalışıyor.
her mail hesabına mesaj veya dosya gönderimi yapıyor.




Microsoft Office Outlook hesablarının kurulumu için linkler

http://www.latis.web.tr/microsoft/
http://www.engintasarim.com/mail/


sayfanın kod bölümündeki kodlar.

Kod:
Private Sub CommandButton1_Click()

'xxxxxxxxxxxxxxxxxxxxxxxxxx Mail Adres Birleştir xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

Set S1 = Sheets(ActiveSheet.Name)
S1.Cells(2, 4).Value = ""

CommandButton3_Click

If S1.Cells(2, 4).Value = "" Then
MsgBox "mail adresi seçilmedi"
Exit Sub
End If
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx


msg1 = MsgBox("Mail dosyası göndermek istiyormusunuz.? " & Chr(10) & Chr(10) & _
"Mail dosyası eklemek için                 EVET  tıklayınız. " & Chr(10) & Chr(10) & _
"Dosya eklemeden göndermek için   HAYIR  tıklayınız. " & Chr(10) & Chr(10) & _
"İşlem yapmadan çıkmak için            İPTAL tıklayınız. ", vbYesNoCancel + vbInformation, "u y a r ı !")

If msg1 = vbCancel Then
Exit Sub
End If


Dim Mail_Dosyası As String

If msg1 = vbYes Then

DsyTur = "Excel Files(*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm"
DsyTur = DsyTur & ",MSForm Resim Dosyaları (*.jpg;*.jpe;*.gif;*.jpeg;*.ico), *.jpg;*.jpe;*.gif;*.jpeg;*.ico"
DsyTur = DsyTur & ",Metin Belgeleri(*.txt), *.txt"
DsyTur = DsyTur & ",Visual Basic Files (*.txt; *.bas), *.txt; *.bas"
DsyTur = DsyTur & ",Tüm Dosyalar(*.*), *.*"
a = Application.GetOpenFilename(DsyTur)

If a = False Then
MsgBox "Kaynak klasörü seçmediniz"
Exit Sub
End If
End If
Mail_Dosyası = a


Dim bool As Boolean
On Error Resume Next

yer = Mid(CreateObject("wscript.Shell").SpecialFolders.Item(1), 1, 2) 'Cells(1, "k").Value

strRefPath = yer & "\Program Files\Microsoft Office\OFFICE12\msoutl.olb" 'ADO
bool = False
For Each ref In ThisWorkbook.VBProject.References
If ref.FullPath = strRefPath Then bool = True
Next

Dim Outlook_Uygulaması As Outlook.Application
Dim Yeni_Mail As Outlook.MailItem

If msg1 = vbYes Then
'Mail_Dosyası = ThisWorkbook.Path & "\liste.xls"   ' Eklene dosya
If CreateObject("Scripting.FileSystemObject").FileExists(Mail_Dosyası) = False Then MsgBox (Mail_Dosyası & Chr(10) & "Eklenecek liste dosyası yok"): Exit Sub
End If


Set Outlook_Uygulaması = New Outlook.Application
Set Yeni_Mail = CreateItem(olMailItem)

With Yeni_Mail

adr = S1.Cells(2, 4).Value

.To = adr

satir1 = S1.Cells(2, "e").Value

.Subject = satir1

satir2 = S1.Cells(2, "H").Value
satir3 = S1.Cells(3, "H").Value
satir4 = S1.Cells(4, "H").Value
satir5 = S1.Cells(5, "H").Value
satir6 = S1.Cells(6, "H").Value
satir7 = S1.Cells(7, "H").Value
satir8 = S1.Cells(7, "H").Value

.Body = satir2 & Chr(13) & Chr(13) & _
satir3 & Chr(13) & Chr(13) & _
satir4 & Chr(13) & Chr(13) & _
satir5 & Chr(13) & Chr(13) & _
satir6 & Chr(13) & Chr(13) & _
satir7 & Chr(13) & Chr(13) & _
satir8 & Chr(13) & Chr(13)

If msg1 = vbYes Then
.Attachments.Add Mail_Dosyası
End If


'.Display ' Maili ekranda görüntüler.
.Send ' Maili direk gönderir.

End With

Set Outlook_Uygulaması = Nothing
Set Yeni_Mail = Nothing


MsgBox "Bu Mail ile " & adr & "  adresine " & ShName & " sayfası gönderildi.", vbApplicationModal, "Bilgilendirme!"


End Sub



Private Sub CommandButton2_Click()
Set S1 = Sheets(ActiveSheet.Name)
Dim sonuc As String, C As Range
On Error GoTo Hata
Set ALAN = S1.Range("c2:c1684")
For Each C In ALAN
    If C <> Empty Then sonuc = sonuc & C.Value & "; " & sALAN
Next C
sonuc = Left(sonuc, Len(sonuc) - Len(sALAN))
S1.Range("d2") = sonuc
On Error GoTo 0

Hata:
BİRLEŞTİRA = "#Error#"

End Sub
Private Sub CommandButton3_Click()

Set S1 = Sheets(ActiveSheet.Name)
For r = 2 To S1.Cells(Rows.Count, "a").End(3).Row  'kisi_sayisi + 1
If S1.Cells(r, "c").Value <> "" Then
If S1.Cells(r, "b").Value = True Then
sonuc = sonuc & S1.Cells(r, "c").Value & "; "
End If
End If
Next

S1.Cells(2, "d").Value = sonuc

End Sub

Modüldeki kodlar

Kod:
Sub Nesneleri_sil()
Dim Picture As Object
For Each Picture In ActiveSheet.Shapes
If TypeName(ActiveSheet.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
Picture.Delete
End If
Next Picture

End Sub

Sub Nesneleriekle()

On Error Resume Next
Set S1 = Sheets(ActiveSheet.Name)
For r = 1 To S1.Shapes.Count
If TypeName(S1.Shapes(r).OLEFormat.Object) = "CheckBox" Then
a = MsgBox("Nesneler mevcut yeniden nesneleri oluşturmak istiyorsanız" & Chr(10) & Chr(10) & _
"Nesneleri sil seçeneğine tıkladıktan sonra yeniden deneyiniz.", vbInformation, " U Y A R I ")
Exit Sub
End If
Next

sut = "b"
For r = 2 To S1.Cells(Rows.Count, "a").End(3).Row  'kisi_sayisi + 1

S1.Rows(r).RowHeight = 18
S1.Cells(r, sut).Font.ColorIndex = 2
 
If S1.Cells(r, "a").Value <> "" Then
yer = S1.CheckBoxes.Add(1, 1, 1, 1).Name
'yer1 = Selection.ShapeRange.AlternativeText
S1.Shapes(yer).OLEFormat.Object.Top = S1.Cells(r, sut).Top + 4 ' + say
S1.Shapes(yer).OLEFormat.Object.Left = S1.Cells(r, sut).Left
S1.Shapes(yer).OLEFormat.Object.Height = S1.Cells(r, sut).Height - 8
S1.Shapes(yer).OLEFormat.Object.Width = S1.Cells(r, sut).Width - 4
S1.Shapes(yer).OLEFormat.Object.Characters.Text = Cells(r, "a").Value

S1.Shapes(yer).OLEFormat.Object.Value = xlOff

S1.Shapes(yer).OLEFormat.Object.LinkedCell = S1.Cells(r, sut).Address
S1.Cells(r, sut).Value = "" ' "YANLIŞ"
S1.Shapes(yer).OLEFormat.Object.Display3DShading = False
'say = say + 1
S1.Shapes(yer).OLEFormat.Object.Name = "Onay Kutusu " & r - 1
'MsgBox ActiveSheet.Shapes(SH.Name).OLEFormat.Object.Name


End If
Next r
'sh.Range("A1").Select
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub


Sub hepsinisec()
'On Error Resume Next
Dim Picture As Object
Set S1 = Sheets(ActiveSheet.Name)
For Each Picture In S1.Shapes
If TypeName(S1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
'If Picture.BottomRightCell.Row >= 24 And Picture.BottomRightCell.Row <= 39 Then
'If Picture.BottomRightCell.Column = 22 Then
S1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOn
'End If
'End If
End If
Next Picture
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "
End Sub
Sub secimlerikaldır()
On Error Resume Next
Dim Picture As Object
Set S1 = Sheets(ActiveSheet.Name)
For Each Picture In S1.Shapes
If TypeName(S1.Shapes(Picture.Name).OLEFormat.Object) = "CheckBox" Then
S1.Shapes(Picture.Name).OLEFormat.Object.Value = xlOff
End If
Next Picture
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "

End Sub

Not mail ile ilgili kodlar bu siteden alınmıştır.
 

Ekli dosyalar

Bu dosyada ofis 2003 den mail gönderme işlemleri anlatılmaktadır.

Yardım sayfasında ofis 2003 de kuruluma ait resimli anlatım mevcuttur.

Mail gönderme sadece gmail.com hesaplarında olmaktadır. Yani gmail.com hesabınız varsa o hesap üzerinden diğer mail adreslerine gönderim yapmaktadır.
 

Ekli dosyalar

ofis 2007 de bu uyarı mesajı kalkıyor ama ofis 2003 de bu uyarı mesajını kaldıramadım.
 

Ekli dosyalar

  • uyarı.JPG
    uyarı.JPG
    17.4 KB · Görüntüleme: 9
Merhaba Halit bey;

Hotmail hesabıyla da outlook tan ileti gönderebiliyoruz. Küçük bir google araması yeterli.

Ekli resimdeki pencereyi otomatik onaylamak için 3 API fonk. ihtiyacınız olacak:

- FindWindow : Pencereyi bulmak için,
- FindWindowEx : Bulunan penceredeki butonu bulmak için,
- SendMessage : Bulunan butonu clik lemek için.
 
Sorgusuz gönderim için bu yol da kullanılabilir.
Kod:
[FONT="Trebuchet MS"][SIZE="2"].display
SendKeys "[COLOR="red"]%G[/COLOR]", True[/SIZE][/FONT]
 
Merhaba Halit bey;

Hotmail hesabıyla da outlook tan ileti gönderebiliyoruz. Küçük bir google araması yeterli.

Ekli resimdeki pencereyi otomatik onaylamak için 3 API fonk. ihtiyacınız olacak:

- FindWindow : Pencereyi bulmak için,
- FindWindowEx : Bulunan penceredeki butonu bulmak için,
- SendMessage : Bulunan butonu clik lemek için.

Zeki Bey merhaba

hotmail hesabıyla outlook tan ileti 2009 yıllarında sorun çıkmış ve 2012 yılına kadar bir çözüm bulunmuş ama şimdiki zamanımızda live.com kaynaklı sorun var galiba ilgili firma türkiye için desteğini çekmiş gözüküyor. sadece bir kaç ülkeye bu hizmeti verdiğini buldum ama ileriki zamanlarda bu hizmetin verileceği söyleniyor.

netten bulduğum aşağıdakilere ait bir çok çözüm var ama hiç biri işe yaramıyor mail bir şekilde ite kalka gidiyor ama pop3 oturum hatası devamlı geliyor.


Microsoft Hotmail için POP3 desteğini hizmete sundu. Daha önce sadece ücretli hesaplara ve bazı ülkelere sunulan bu hizmet, artık tüm dünyaya açılmış durumda.
Windows Live Hotmail hesabınızı Outlook 2007 de kullanmak için aşağıdaki ayarları adım adım uygulayın. Ayarlar test edilmiştir.
1. Outlook’u açın. Ayarlar menüsünden hesap ayarlarına tıklayın. “Hesap Ayarları” penceresi açılacaktır.
2. Yeni butonuna tıklayarak “Yeni E-posta Hesabı Ekle” penceresinin açılmasını sağayın ve “Microsoft Exchange, POP3, IMAP ve HTTP” seçeneğini seçin ve ileri butonuna tıklayın.
3. “Sunucu ayarlarını veya ek sunucu türlerini el ile yapılandır” seçeneğini seçin ve ileri butonuna tıklayın.
4. “Internet E-Posta” seçeneğini seçip ileri butonuna tıklayın.
5. Ekrandaki girişleri eksiksik doldurun. Girişler aşağıdaki gibi doldurulmalıdır.



a. Adınız: Adınız ve soyadınız ( Bu alan mail gönderdiğinizde gönderdiğiniz kişinin mail kutusunda kimden kısmında yazacak olan bilgidir.)
b. E-Posta Adresi: adınızsoyadınız@hotmail.com veya adınızsoyadınız@windowslive.com (Buraya Windows Live Hotmail adresinizi yazmalısınız.)
c. Hesap Türü: POP3
d. Gelen Posta Sunucusu: pop3.live.com
e. Giden Posta Sunucusu(SMTP): smtp.live.com
f. Kullanıcı Adı: adınızsoyadınız@hotmail.com veya adınızsoyadınız@windowslive.com
g. Parola: Mail şifresiniz.
h. Parolamı Anımsa: işaretleyin. İşaretlemezseniz her Outlook açıldığında size parola soracaktır.
i. Güvenli Parola kimlik doğrılaması (SPA) kullanarak durum açılsın: işaretleyin.

6. Bilgileri eksiksiz girdikten sonra “Diğer Ayarlar” butonuna tıklayın. “Internet E-Psota Ayarları” penceresi açılacaktır.
7. Giden sunucu sekmesinden “Giden sunucum (SMTP) için kimlik doğrulaması gerekiyor” seçeneğini seçin. Hemen altındaki “Gelen posta sunucum ile aynı ad ayarlarını kullan” seçeneğini seçin.
8. “Gelişmiş” sekmesinden “Gelen sunucusu(POP3) portu olarak 995 girin. “Bu sunucu şifreli bir bağlantı (SSL) gerektirir” seçeniğini seçin. “Giden sunucu (SMTP) portu olarak 587 girin. “Aşağıdaki şifreli bağlantı türünü kullan:” seçeği için TLS seçin ve Tamam butonuna tıklayın.
9. Hesap ayarlarını sına butonuna tıkladığımızda sınama başarıyla tamamlanacaktır.
10. İleri butonuna tıklayıp sonraki pencereden son butonuna tıklayarak ayarlarımızı bitirmiş olacağız.
11. Güle güle kullanın.
 
Sorgusuz gönderim için bu yol da kullanılabilir.
Kod:
[FONT="Trebuchet MS"][SIZE="2"].display
SendKeys "[COLOR="red"]%G[/COLOR]", True[/SIZE][/FONT]

Murat Bey

SendKeys işlemide işlem görmedi bende bu yüzden ofis 2007 nin outlook unu kurdum.
 
Evdeki bilgisayarımda outlook & hotmail kullanıyorum. Kuralı uzun zaman oldu; tam hatırlamıyorum ama http protokolu ile yapılandırmıştım sanırım.
 
Aşağıdaki proseduru test edin Halit bey. Eklediğiniz resimdeki pencere ve butona göredir. (2003 yüklü olmadığı için deneme imkanım olmadı)

Kod:
#If Win64 And VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
        ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" ( _
        ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
        
    Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As Long

    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
        ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
        ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
    
    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
#End If

Private Const BM_CLICK = &HF5


Sub test()
    Set app = CreateObject("Outlook.Application")
    
    Set msg = app.CreateItem(0)

    msg.To = "adres"
    msg.Subject = "konu"
    msg.Body = "mesaj"
    msg.Send
    
    Do
        DoEvents
       [COLOR=DarkGreen] 'Pencereyi bulana kadar çalış[/COLOR]
        hw = FindWindow(vbNullString, "Microsoft Office Outlook")
        If hw <> 0 Then Exit Do
    Loop
    
   [COLOR=DarkGreen] 'Ekran güncellemesini kapat (Pencere ekranda görünmeyecek)[/COLOR]
    Call LockWindowUpdate(hw)
    
    [COLOR=DarkGreen]'Evet butonunu bul[/COLOR]
    hwEvet = FindWindowEx(hw, 0&, "Button", "Evet")
    
   [COLOR=DarkGreen] 'Butona bas[/COLOR]
    Call SendMessage(hwEvet, BM_CLICK, 0, 0)
    
   [COLOR=DarkGreen] 'Ekran güncellemesini aç[/COLOR]
    Call LockWindowUpdate(0)
End Sub
 
Zeki Bey
kod aşağıdaki kırmızı alan da imleç duruyor ve compile error: Type mismatch uyarısı veriyor tamam yardım seçeneği çıkıyor ve tamam ı tıklayıncada imlec kırmızı işaretli yerde duruyor.

Kod:
Call SendMessage(hwEvet, BM_CLICK, 0, [COLOR="Red"]0[/COLOR])

bende sıfır değerleri sayıya çevirdim sonuç yok yani yukarıdaki mesajımdaki resim de de gösterdiğim evet hayır yardım uyarı seçeneği geliyor.

Call SendMessage(hwEvet, BM_CLICK, CLng(0), CLng(0))
 
HALİT BEY,
Bende uzun zamandır otomatik mail gönderme üzerinde araştırma yapıyordum en sonunda sizin mailinizi görünce çok sevindim benimde sizden bir ricam olacak ekte deneme bir excell dosyası oluşturdum dosyada
1 olap sayfası
2 ana sayfa
3 mail listesi bulunmaktadır
hersabah 8 de deneme tablosununun açılıp olap kısmı sağ klik refresh yapıldıktan sonra ana sayfa sheeti formüller kaldırılarak move or copy yapılıp ve sıkıştırılarak mail sayfasında bulunan kişilere outlooktan mail atmasını istiyorum
konu hakkında yardımcı olursanız çok memnun olurum
iyi çalışmalar
 

Ekli dosyalar

HALİT BEY,
Bende uzun zamandır otomatik mail gönderme üzerinde araştırma yapıyordum en sonunda sizin mailinizi görünce çok sevindim benimde sizden bir ricam olacak ekte deneme bir excell dosyası oluşturdum dosyada
1 olap sayfası
2 ana sayfa
3 mail listesi bulunmaktadır
hersabah 8 de deneme tablosununun açılıp olap kısmı sağ klik refresh yapıldıktan sonra ana sayfa sheeti formüller kaldırılarak move or copy yapılıp ve sıkıştırılarak mail sayfasında bulunan kişilere outlooktan mail atmasını istiyorum
konu hakkında yardımcı olursanız çok memnun olurum
iyi çalışmalar

kod:

Kod:
#If VBA7 Then
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperationAs String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Sub mail_gönder()
Dim Outlook_Uygulaması As Object
Dim Outlook_Mail As Object

Set S1 = Sheets("mail listesi")
Set S2 = Sheets("ana sayfa")

Program_Yolu = "C:\Program Files\WinRAR\WinRAR.exe"

If Dir(Program_Yolu) = "" Then
MsgBox "Sisteminizde yüklü WinRAR sıkıştırma programını bulunamamıştır !" & vbCrLf & "Lütfen daha sonra tekrar deneyiniz !", vbCritical, "Dikkat !"
Exit Sub
End If

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

yer = Format(Now, "dd-mm-yyyy-hh-nn-ss") & " " & fL.GetBaseName(ThisWorkbook.Name)
Dosya_Adı = InputBox("Arşivlenecek dosya adını yazınız.", "Uyarı", yer)


If Dosya_Adı = "" Or Dosya_Adı = False Then
MsgBox "Hatalı dosya adı girdiniz yada işlemi iptal ettiniz !" & vbCrLf & "Lütfen daha sonra tekrar deneyiniz !", vbExclamation, "Dikkat !"
Exit Sub
End If

Dosya_Adı = Replace(Dosya_Adı, " ", "-")
Yol = ThisWorkbook.Path & "\" & Dosya_Adı

deg1 = Split(Yol, " ")

If UBound(deg1) > 0 Then
MsgBox Yol & Chr(10) & UBound(deg1) & " kerekter boşluk var" & Chr(10) & "ilgili klasör adında veya yolunda kelimeler arasında boşluklar var"
For i = 0 To UBound(Split(Yol, " "))
MsgBox deg1(i)
Next
MsgBox "Dosya yolunu değiştirin."
Exit Sub
End If

S2.Copy
'Sheets(ActiveSheet.Name).Name = "Sayfa1"
Sheets(ActiveSheet.Name).Cells.Copy
Sheets(ActiveSheet.Name).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Yol & "." & fL.GetExtensionName(ThisWorkbook.Name)
ActiveWorkbook.Close False

ShellExecute 0, "Open", Program_Yolu, "A -ep " & Yol & " " & Yol & "." & fL.GetExtensionName(ThisWorkbook.Name), "", vbHide
Application.Wait Now + TimeValue("00:00:10")

Set Outlook_Uygulaması = CreateObject("Outlook.Application")
Outlook_Uygulaması.Session.Logon
Set Outlook_Mail = Outlook_Uygulaması.CreateItem(0)

With Outlook_Mail

.To = S1.Cells(1, "b").Value
.CC = S1.Cells(2, "b").Value
.BCC = S1.Cells(3, "b").Value
.Subject = "konu başlığı"
.Body = "merhaba"
.BodyFormat = 2
.Attachments.Add Yol & ".rar"
'.Display
.Send
End With

Set Outlook_Mail = Nothing
Set Outlook_Uygulaması = Nothing
fL.DeleteFile Yol & "." & fL.GetExtensionName(ThisWorkbook.Name) 'Dosya_Adı
fL.DeleteFile Yol & ".rar" ' rar adı
End Sub
 
Mail Gönderme

Halit Bey,
Öncelikle ellerinize sağlık formülleri kopyaladım fakat benim excell ingilizce olmasından hata verdi birde Olap sayfasındaki datayı refresh formülünü göremedim rica etsem formülleri revize edip ve benim DENEME isiminde örnek olarak gönderdiğim tabloya ekleyebilirmisiniz.
iyi çalışmalar
 
Son düzenleme:
Halit Bey,
Öncelikle ellerinize sağlık formülleri kopyaladım fakat benim excell ingilizce olmasından hata verdi birde Olap sayfasındaki datayı refresh formülünü göremedim rica etsem formülleri revize edip ve benim DENEME isiminde örnek olarak gönderdiğim tabloya ekleyebilirmisiniz.
iyi çalışmalar

dosyanız ektedir
 

Ekli dosyalar

Halit Bey,
Ellerinize sağlık çok güzel olmuş
teşekkürler
iyi çalışmalar
 
Son düzenleme:
Halit Bey,
tekrar ellerinize sağlık
peki oluşturduğunuz makroya zaman eklenebilirmi örnek sabah 08:00 gibi kendiliğinden çalışabilirmi?
selamlar
 
Halit Bey,
tekrar ellerinize sağlık
peki oluşturduğunuz makroya zaman eklenebilirmi örnek sabah 08:00 gibi kendiliğinden çalışabilirmi?
selamlar

Bu durumda dosyanın devamlı açık kalması gerekir
Diğer taraftan açık olan excell dosyaları da bu durumdan etkilenecektir.
 
Bu dosyanın içinde exe uzantılı dosya mevcut
bu dosyayı ve mail göndereceğin excell dosyasını aynı klasörün içine koy ve exe uzantılı dosyayı çalıştır liste kutusundan mail için açılacak dosyayı seç ve açılan liste kutusundan da zamanı yani dosyanın açılacağı zamanı seç ve başkada hiç bir şey yapma saat geldiğinde seçili dosyayı açacak ve mail gönderilecektir.

not:dosyanın açılması için makro güvenik düzeyi düşük olmalı
 

Ekli dosyalar

Geri
Üst