- Katılım
- 17 Ocak 2006
- Mesajlar
- 241
- Excel Vers. ve Dili
- excel xp türkçe
Günaydın arkadaşlar!....
2 gündür aradığım visual basicde exceli kullanarak email gönderme işlemi ile ilgili kodu buldum ama kodda bi takım eksiklikler var:
Bu konuda bana yardımcı olursanız sevinirim...
Kod:
Dim Msg As String, Cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Dim KacMail As Integer
Dim SonSat As Integer
Dim Bady As String
Sheets("Sayfa1").Activate
SonSat = Sheets("Sayfa1").Cells(65000, 1).End(xlUp).Row
'For i = 2 To SonSat
'For i = 2 To 1
'If Cells(i, 1) = "Y" And Cells(i, 4) <> "" Then
'Recipient = Sheets("Sayfa1").Cells(i, 4).Value
Recipient = "floclub@flo.com.tr"
Recipientcc = ""
Recipientbcc = ""
'Subj = Sheets("Yoklama").Range("dersadi").Value & " dersindeki devamsızlık durumunuz."
Subj = "deneme email"
Bady = ""
'Msg = Sheets("sayfa1").Cells(65000, 1).Text
'Msg = "Bu bir deneme yazısıdır"
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & Bady & " " & vbCr & Msg
ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s", True
KacMail = KacMail + 1
'End If
'Next i
------------------
Yapılması gereken Msg olan kısma excel sayfa 1 deki tüm verilerin gelmesini istiyorum....
eski kodlarla değişiklik yaptığım tüm kodlar yukarıda bu konuda bana yardımcı olursanız sevinirim.
2 gündür aradığım visual basicde exceli kullanarak email gönderme işlemi ile ilgili kodu buldum ama kodda bi takım eksiklikler var:
Bu konuda bana yardımcı olursanız sevinirim...
Kod:
Dim Msg As String, Cell As Range
Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Dim KacMail As Integer
Dim SonSat As Integer
Dim Bady As String
Sheets("Sayfa1").Activate
SonSat = Sheets("Sayfa1").Cells(65000, 1).End(xlUp).Row
'For i = 2 To SonSat
'For i = 2 To 1
'If Cells(i, 1) = "Y" And Cells(i, 4) <> "" Then
'Recipient = Sheets("Sayfa1").Cells(i, 4).Value
Recipient = "floclub@flo.com.tr"
Recipientcc = ""
Recipientbcc = ""
'Subj = Sheets("Yoklama").Range("dersadi").Value & " dersindeki devamsızlık durumunuz."
Subj = "deneme email"
Bady = ""
'Msg = Sheets("sayfa1").Cells(65000, 1).Text
'Msg = "Bu bir deneme yazısıdır"
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc & "&" & "bcc=" & Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & Bady & " " & vbCr & Msg
ActiveWorkbook.FollowHyperlink (HLink)
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%s", True
KacMail = KacMail + 1
'End If
'Next i
------------------
Yapılması gereken Msg olan kısma excel sayfa 1 deki tüm verilerin gelmesini istiyorum....
eski kodlarla değişiklik yaptığım tüm kodlar yukarıda bu konuda bana yardımcı olursanız sevinirim.