excelde seçili sütunları email gönderme

[mustilem23]

sayın Plint ,

evet aynen bahsettiğiniz gibi deneme yaptım ve kodları değiştirdim fakat ,sürekli olarak sayfa 1 a2 deki email adreslerini alıyor kime kısmına , test ettim tedarikçi nosunu a2 satırında değiştirdim fakat sonuç aynı

isterseniz konu için yeni bir form oluşturmuştum ordan devam edelim ,
http://www.excel.web.tr/f48/aktif-sayfayy-email-olarak-gonderme-artly-t161309.html#post877872


Aktif sayfadaki A sutunun da ki tedarikçi nosunu alıp sayfa 1 de yada belirli bir excelin içindeki a sutununda araYıp karşılık gelen b c d e f g h ı j k satırların daki email adreslerini emailin adresler kime kısmını yapıştırmasını rica ediYorum ve excel sayfasında a b c d e f g h ı j k l karşılık gelen satır ve sutunların emailin yazı satırına eklenebilmesi mümkün müdür

 

[PLİNT]

sayın Plint ,

evet aynen bahsettiğiniz gibi deneme yaptım ve kodları değiştirdim fakat ,sürekli olarak sayfa 1 a2 deki email adreslerini alıyor kime kısmına , test ettim tedarikçi nosunu a2 satırında değiştirdim fakat sonuç aynı
Aktif sayfadaki A sutunun da ki tedarikçi nosunu alıp sayfa 1 de yada belirli bir excelin içindeki a sutununda araYıp karşılık gelen b c d e f g h ı j k satırların daki email adreslerini emailin adresler kime kısmını yapıştırmasını rica ediYorum ve excel sayfasında a b c d e f g h ı j k l karşılık gelen satır ve sutunların emailin yazı satırına eklenebilmesi mümkün müdür

Sayfa adı sabit kaldığı içindir.
Ek dosyayı deneyin, aynı kodlarda sayfa adı aktif sayfa
http://s3.dosya.tc/server10/1z246x/secili_sutun_email_gonderme.zip.html

 

[mustilem23]

Sayın PLİNT ,

İlginiz için teşekkürler,dosya yı indiridim çalışıyor ,fakat şöyleki bir kaç sıkıntı var ,
sanırım biraz eksik bilgi ilettim size özür dilerim.,

Benim amacım şirkkette kullandığım programdan bir rapor alıyorum tedarikçide bekleyen siparişler için ,

A sütunun da bulunan tedarikçi noları var yaklaşık alt alta 900 adet toplamda 2500 satır ben filitre yapıp o tedarikçide buulunan ürünleri soracağım email ile.


birkaç sıkıntım var şöyle kodu aktif sayfada kullanmak istiyorum çünkü rapor aldığım da excel sayfası her seferinde adı değişiyor.

birde buradaki satırdan aldığı verye yazı eklemek istiyorum ,

.Subject = Replace(act.Range("a2").Text, "*", "")

Örnek (m0120316 tedarikçi gecikme bildirimi)

birde bu var fakat sanırım olurmu bilmiyorum süper olur ,h sütunum da sipariş oluşturma tarihim mevcut .(oluşturma tarihi ile bugünün tarihi arasında geçen günü hesaplayıp ı sutun ve satırlarına yazdırabilmek mümkün müdür.)

 

[mustilem23]

Sayın Plint 24 nolu mesajımı okuma şansınız oldu mu acaba .

 

[PLİNT]

Merhaba
Son mesajımdaki dosyada kodlar aktif sayfayı gönderiyor,
ilgili satırı, aşağıdaki gibi değiştirirseniz süzme işleminden sonra "A1" hücresinin altına gelen
ilk hücreden tedarikçiyi alacaktır.

.Subject = Replace(act.Range("A" & i).Text, "*", "") & " tedarikçi gecikme bildirimi"

http://s3.dosya.tc/server10/t3xz8l/secili_sutun_email_gonderme.zip.html

 

[mustilem23]

Sayın PLİNT ,

Çok hakılısınız bir kaç deneme yaptım çalışır gibi yapıyor fakat aşağıdaki hatayı alıyorum diğer excellerde'de

i = act.Range("A2:A" & act.Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Row

aslında benim amacım ı.f.s adlı programdan veriyi aldığım gibi işleme başlamak istiyorum , pc ye kaydetmeden veriyi yani ,program exceli önbellekte tutuyor sanırım xls formatında sorun bundan oluyor olabilir mi ,ama aynı sorunu kayıtlı xlsx formatında da alıyorum.

 

[PLİNT]

Sayın PLİNT ,

Çok hakılısınız bir kaç deneme yaptım çalışır gibi yapıyor fakat aşağıdaki hatayı alıyorum diğer excellerde'de

aslında benim amacım ı.f.s adlı programdan veriyi aldığım gibi işleme başlamak istiyorum , pc ye kaydetmeden veriyi yani ,program exceli önbellekte tutuyor sanırım xls formatında sorun bundan oluyor olabilir mi ,ama aynı sorunu kayıtlı xlsx formatında da alıyorum.

Süzme işlemi yapılmadığında vermiştir,
o bölümün bir alt ve bir üstüne ek yapalım filtreleme yapılmadığında
"A2" deki tedarikçiyi alsın

[COLOR="Red"]On Error Resume Next[/COLOR]
 i = act.Range("A2:A" & act.Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Row
[COLOR="Red"] If i = Empty Then i = 2: Err = 0[/COLOR]

 

[mustilem23]

Evvet oldu aktif sayfaları artık alıyor fakat örnek dosyamdaki gibi emailin içeriğine

Outlok ileti dosyasına seçili satırları eklemiyor ve kime kısmına email adresi yerine (*2736; IptalEdildi; Envanter Siparisi) bu yazıları yazıyor , kontrol edebilmeniz mümkün müdür,

rica etsem bir de cq sütunum da oluşturma tarihi mevcut ,bu sütundaki tarihten bugünü çıkartsa ve konu konu metnine

şu satırın ardından

.Subject = Replace(act.Range("A" & i).Text, "*", "") & " tedarikçi gecikme bildirimi"

geçen süreyi gün olarak yazdırtabilmek mümkün müdür .

Tedarikçiler çok kızacak :agla:

http://s8.dosya.tc/server3/oiku0j/secili_sutun_email_gonderme__1_.rar.html

 

[PLİNT]

Outlok ileti dosyasına seçili satırları eklemiyor ve kime kısmına email adresi yerine (*2736; IptalEdildi; Envanter Siparisi) bu yazıları yazıyor , kontrol edebilmeniz mümkün müdür,

Dosyanızdaki kodlarda bu bahsettiğiniz şekilde "B,C,D" sütunların dan gelen
hücreleri birleştiren kod yok.
Bu sütunların mesaja eklenmesin derseniz o başka;

rica etsem bir de cq sütunum da oluşturma tarihi mevcut ,bu sütundaki tarihtenbugünü çıkartsa ve konu konu metnine

Bu isteğiniz içinde ek dosyayı deneyiniz. Böyle daha etkili olmazmı?

http://s3.dosya.tc/server10/xuqhrs/secili_sutun_email_gonderme.zip.html

 

[mustilem23]

sayın plint gece gece sizi uğraştırdım ,tarih özelliği için çok teşekkürler , fakat tarih değişse bile 366 gün diyor sürekli olarak.

Örnek dosyam da outlook dosyasını açma imkanınız olabildi mi halen durum aynı aktif sayfada bunu yapıyor , kodların olduğu excel'de böyle bir durum yok onun için outlook dosyası ve örnek aktif excel dosyası eklemiştim.

 

[PLİNT]

sayın plint gece gece sizi uğraştırdım ,tarih özelliği için çok teşekkürler , fakat tarih değişse bile 366 gün diyor sürekli olarak.

"CG" sütununda (mesela örnekte 2. satırı) alınan tedarikçi satırındaki tarihi alıyor.
http://s3.dosya.tc/server10/b70nhq/secili_2.zip.html
http://hizliresim.com/41APl0

Örnek dosyam da outlook dosyasını açma imkanınız olabildi mi halen durum aynı aktif sayfada bunu yapıyor , kodların olduğu excel'de böyle bir durum yok onun için outlook dosyası ve örnek aktif excel dosyası eklemiştim.

Örnek dosyada bulunan tedarikçi mail listesi "Sayfa1" de bulunuyor
bu liste hangi sayfada ise kodlardaki sayfa adını değişmelisiniz.
modülde;

 Sub mail()
Dim hcr As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim act, s1 As Worksheet
    Dim i, r, p, ı, kime
    Dim gün As Long
    Set hcr = Nothing
    Set act = ThisWorkbook.ActiveSheet
Set s1 = [COLOR="Red"]Sheets("Sayfa1")[/COLOR]
On Error Resume Next 
'....
'.....diğer kodlar

 

[mustilem23]

evet haklısınız tarih değişti ,ben cq siz cg hafif bir eğrilik var

örnek aktif sayfada evet hata yapmışım ,sayfa 1 e verileri eklemişim ,şimdi yine test ettim yeni bir aktif sayfada sayfa 4 veri ekledim sayfa 1 boş bıraktım çalıştırdım fakat email oluşturdu fakat konu başlığından başka bir şeyler gelmedi ,aynı aktif excelin sayfa 1 ine tedarikçi bilgilerini ekledim çalıştı emailleri aldı fakat bu sefer de excel verilerini ve gün hesabını almadan bir email oluşturdu.,

özetler isek Aktif bir sayfa açtım ve makrolu exceli açtım ,macrolu excel deki safa 1 i kopyaladım aktif sayfadaki sayfa 1 e yapıştırdım ve makroyu çalıştırdım gibi mantıkla çalışacak ,

 

[PLİNT]

Karışıklık oluyorsa, ek dosyayı deneyelim.
Mail dosyasında ki mail liste sayfası (sayfa1) farklı bir dosya olarak eklendi.
Butona bastığınız zaman yanındaki liste dosyasından tedarikçiyi arayıp karşısındaki adresleri alacak.
http://s3.dosya.tc/server10/d7wbcu/Dosyalar.zip.html

 

[mustilem23]

elinize ve emeğinize sağlık çok teşekkürler, pazartesi ilk iş şirkette test edeceğim.

 

[mustilem23]

Sayın Plint ,

Yaptığınız iş yapımda o kadar çok kullanmaya başladım ki , artık yazılımı prsonel.xlb ye taşımak istiyorum .
Bu durumu çözümleyebilmenin bir yolu mevcut mudur .

Şirkette kullanmış olduğum programdan gelen data exceli ektedir .
Son kullandığım yazılımda ektedir desteğinizi rica eder hayırlı günler dilerim.

 

[PLİNT]

 

Merhaba
Örnek dosyayı inceleyin
form dan "dosya seç" butonu ile açılan pencereden (ListeSasSatırları ) dosyanızı seçersiniz, açılan dosyadaki "A"sütununda bulunan isimlere görede; "mailci"
dosyasındaki (isimlere göre) kayıtlı mail adresleri listelenir; hepsini veya istediklerinizi seçip gönder tuşunu tıklarsınız
Eksiklikleri bildirirsiniz


https://www.dosyaupload.com/ft3u

Aşağıdaki eklenti (xlam) dosyası ama adresleri almak için "ListeSasSatırları" dosyasına sayfa ekleyip adresleri yazmak gerekir yukarıdaki dosya daha kullanışlı olacaktır
https://www.dosyaupload.com/ft3z
"prsonel.xlb" ile nasıl kullanacağınızı anlayamadım

 

[mustilem23]

Üstad eline sağlık user form süper olmuş , lakin benim düşündüğüm gibi çalıştıramıyorum .

Şöyle ki benim e mail atacağım kişi sayısı ortalama 10 yada 15 kişi sabit bu kişileri personel xlb vba asının sayfa 1 ine eklesek user formu yada kodlamayı modülden çalıştırsak daha uygun olabilir mi yada mümkün müdür:

Olmaz ise user formda d sutunu da göre (Sipariş Ref 1) sıralatabilir miyiz , bu e-maili atmamın 2 sebebi var 1 müşteri siparişi olduğunu belirtmek diğeri de kaç gündür açık olduğunu belirtmek adına .
Destekleriniz için şimdiden teşekkürler .

 

[PLİNT]

Eklenti dosyası:
https://www.dosyaupload.com/bhxD

Çalıştırılacak makro "sub mailci"
Run ("maileklenti.xla!mailci")
İstediğiniz dosyada (sütunları mail gönderilecek dosya; aktif iken) modüle ekleyerek kullanabilirsiniz.
Modul kodları

Public dc As Object
Public v As Worksheet, kime As String
Sub mailci()
With ActiveWorkbook.ActiveSheet
x = .Cells(Rows.Count, "A").End(3).Row
.Range("A2:N" & x).Sort Key1:=.Cells(2, "D"), Order1:=xlAscending
.Range("A2:N" & x).Sort Key1:=.Cells(2, "A"), Order1:=xlAscending
Call mail_liste
For i = 2 To x
.AutoFilterMode = False
If WorksheetFunction.CountIf(.Range("A1:A" & i), .Cells(i, "A")) = 1 And Trim(.Cells(i, "A")) <> "" Then
.Range("A1:M" & x).AutoFilter Field:=1, Criteria1:=Trim(.Cells(i, "A").Text), Operator:=xlFilterValues
kime = dc.Item(Trim(.Cells(i, "A").Text))
Call mail
End If
Next
.AutoFilterMode = False
End With
End Sub
Sub mail_liste()
Set dc = CreateObject("Scripting.Dictionary")
dc.CompareMode = vbTextCompare
dc.Add "AOZTURK", "xxxx@koxxxxas.com.tr"
dc.Add "BTASDEMIR", "xxxx@kxxxxxas.com.tr"
dc.Add "CURESIN", "xxxx@koxxxxxas.com.tr"
dc.Add "DANIL", "xxxxxx@kxxxxas.com.tr"
dc.Add "ERHANY", "xxxxx@koxxxxxas.com.tr"
dc.Add "FKAHRAMAN", "xxxxxxs.com.tr"
dc.Add "GSEZGINER", "xxxxx@koxxxxas.com.tr"
dc.Add "HSADAK", "xxxxx@kxxxxas.com.tr"
dc.Add "IKAHRAMAN", "xxxxx@koxxxxas.com.tr"
dc.Add "MCICEK", "btasdemir@kxxxas.com.tr"
dc.Add "MYILDIRIM", "xxxxxx@kxxxas.com.tr"
dc.Add "TRUSTEMOGLU", "xxxxxxxr@kxxxxas.com.tr"
dc.Add "Meeylan", " btxxxxxr@kxxxxas.com.tr"
dc.Add "Emirbag", "btaxxxxxir@kxxxas.com.tr"
dc.Add "ECENGIZ", "bxxxxxmir@kmas.com.tr"
End Sub
Sub mail()
Dim hcr As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim act, s1 As Worksheet
    Dim i, r, p, ı
    Dim gün As Long
    Set hcr = Nothing
    Set act = ActiveWorkbook.Sheets(1)
Set s1 = ActiveWorkbook.Sheets(1)
On Error Resume Next
i = act.Range("A2:A" & act.Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Row
If i = Empty Then i = 2: Err = 0

If kime = Empty Then MsgBox "kime boş": Exit Sub

Set hcr = act.Range("A1:K" & act.Cells(Rows.Count, "A").End(3).Row)
gün = DateDiff("d", act.Cells(i, "h"), Date)
On Error GoTo 0
Application.EnableEvents = False
Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = kime
        .CC = ""
        .BCC = ""
        .Subject = Replace(act.Range("c" & i).Text, "*", "") & " Nolu talep yedek parça sipariş durumu hakkında ."
        .BodyFormat = 2
        .HTMLBody = "<HTML><H5><BODY>" & gün & "    siparişten bugüne , " & vrhtml(hcr)
        .Save
        '.........................
        '.Send  '..........GÖNDERMEK İÇİN
        '............
        .Display
    End With
    On Error GoTo 0
Application.EnableEvents = True
        Application.ScreenUpdating = True
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Function vrhtml(hcr As Range)
    Dim fs As Object
    Dim ts As Object
    Dim kyt As String
    Dim ktp, bu As Workbook
    Dim n As Integer
    Dim act2 As Worksheet
    kyt = ThisWorkbook.Path & "\" & "yeni" & ".htm"
    hcr.Copy
Set bu = ActiveWorkbook
Set act2 = ActiveWorkbook.ActiveSheet

Set ktp = Workbooks.Add(1)
    With ktp.Sheets(1)
        .Cells(1).PasteSpecial
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    For n = 1 To 15
ktp.Sheets(1).Columns(n).ColumnWidth = act2.Columns(n).ColumnWidth
Next

ktp.Sheets(1).UsedRange.Borders.Weight = xlThin
ktp.Sheets(1).Range("A" & ktp.Sheets(1).Cells(Rows.Count, "A").End(3).Row + 2) = "Talebimiz yedek parça siparişidir öncelik verilmesini ivedi getirtilmesi konusunda yardımcı olabilir misiniz .En erken teslimat tarihi ile ilgili acil bilgi iletebilir misiniz.Teşekkürler. "
    With ktp.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=kyt, _
         Sheet:=ktp.Sheets(1).Name, _
         Source:=ktp.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.GetFile(kyt).OpenAsTextStream(1, -2)
    vrhtml = ts.readall
    ts.Close
    vrhtml = Replace(vrhtml, "align=center x:publishsource=", "align=left x:publishsource=")
    ktp.Close savechanges:=False
    Kill kyt
    Set ts = Nothing
    Set fs = Nothing
    Set ktp = Nothing
End Function

 

[mustilem23]

Üstadım eline sağlık çok sağol süper oldu resmen tek tıkla oluyor tüm acık siparişler ,Bursa ya yolun düşerse kahve içmeye beklerim hayırlı günler.

 

[mustilem23]

Sayın Plint ,

Konuya ilişkin aynı kodlamayı şimdide arge birimi için yapmaya çalıştım lakin tüm satırları bir e mailde göndermeye çalışıyor , son durumu ek olarak ekledim yardımcı olabilir misiniz rica etsem.