SAYFALARI AYRI AYRI Klasöre Kaydetme

muzos80

Altın Üye
Katılım
21 Aralık 2013
Mesajlar
45
Excel Vers. ve Dili
2013 - Türkçe
Birilerin işine yarar aşağıdaki kod ile sorunu çözdüm Necati ustama da teşekkür ederim

Application.DisplayAlerts = False
Set nesne = CreateObject("Scripting.FileSystemObject")
Yol = "\\DENEME"
klasoradi = ActiveWorkbook.Sheets("FORM").Cells(5, 2).Text
dosyaadi = ActiveWorkbook.Sheets("FORM").Cells(5, 2).Text
klasorara = nesne.FolderExists(Yol & "\" & klasoradi)
If klasorara = False Then nesne.CreateFolder Yol & "\" & klasoradi


ActiveSheet.Copy
With ActiveWorkbook
ActiveWorkbook.SaveAs Filename:=Yol & "\" & klasoradi & "\" & dosyaadi & ".xlsx", FileFormat:=xlOpenXMLWorkbook

.Close
End With
Worksheets("ARŞİV").Select
sonsat = Worksheets("ARŞİV").Range("K" & 65536).End(xlUp).Offset(1, 0).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Yol & "\" & klasoradi & "\" & dosyaadi & ".xlsx", TextToDisplay:=Yol & "\" & klasoradi & "\" & dosyaadi & ".xlsx"
 

muzos80

Altın Üye
Katılım
21 Aralık 2013
Mesajlar
45
Excel Vers. ve Dili
2013 - Türkçe
Merhaba Bir eklenti yapabilirmiyim Arşiv sayfasına veri kaydedildiğinde son kayıt edileni, bilirli 10 kişiye outlook 2016 ve üzerinde çalışacak otomatik toplu mail gönderimi yapabilirmiyiz
 
Katılım
20 Şubat 2007
Mesajlar
503
Excel Vers. ve Dili
2007 Office, Tr
Merhaba,
Kaydedilen "Form" sayfasını ek olarak koyduğunuz bir mail gönderilecek değil mi?
Gönderilecek kişilerin mail adreslerini manuel mi gireceksiniz, sayfadaki bir aralıktan mı alacaksınız?
 

muzos80

Altın Üye
Katılım
21 Aralık 2013
Mesajlar
45
Excel Vers. ve Dili
2013 - Türkçe
Arşiv sayfasını gönderecek yada Arşiv sayfasına eklediği son verileri B den K ya kadar olanını mail atmasını istiyorum yani bilgi maili olacak
 

muzos80

Altın Üye
Katılım
21 Aralık 2013
Mesajlar
45
Excel Vers. ve Dili
2013 - Türkçe
Gönderilecek kişilerin mail adrslerini makroda yazılı olması daha iyi olur
 
Katılım
20 Şubat 2007
Mesajlar
503
Excel Vers. ve Dili
2007 Office, Tr
Arşiv sayfasındaki son satırı mail atmak için olan kodlar şöyle:
Kod:
Sub SeciliAlaniMailAtmak()
'Exceldeki seçili bir alanı mail gövdesine yapıştırıp mail atar..
Dim oOutlookApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim xlRng As Range

Set oOutlookApp = CreateObject("Outlook.Application")
Set oItem = oOutlookApp.createitem(0)
sons = Worksheets("ARŞİV").Cells(Rows.Count, "K").End(3).Row
Set xlRng = Worksheets("ARŞİV").Range("B" & sons & ":K" & sons)
xlRng.Copy

    With oItem
        .display
        .BodyFormat = 2
        .To = "filanca@mail.com.tr;filanca@mail.com.tr"  'Diğer mail adreslerini buraya eklemelisiniz
        .Subject = "Ekli satırların gönderimi"           'Konu yazılacak yer
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.collapse 1
        oRng.Text = "Mail gövdesine yazmak istediğin cümle varsa buraya yaz" & vbCr 
        oRng.collapse 0
        oRng.Paste
        oRng.collapse 0
        oRng.Text = vbCr & "Mail gövdesi sonuna yazmak istediğin cümle varsa buraya yaz"
    End With

    Set oItem = Nothing
    Set oOutlookApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set xlRng = Nothing
End Sub
 

muzos80

Altın Üye
Katılım
21 Aralık 2013
Mesajlar
45
Excel Vers. ve Dili
2013 - Türkçe
Süpersin çok teşekkür ederim iş yerine gidince deneyeceğim
 

muzos80

Altın Üye
Katılım
21 Aralık 2013
Mesajlar
45
Excel Vers. ve Dili
2013 - Türkçe
Başarılı oldu istediğim gibi ama Gönderme ekranında kaldı gönderme yapamadı yada bizde şirket içi diye seçme yapmamız gerekiyor ondan dolayı da olabilir
 
Katılım
20 Şubat 2007
Mesajlar
503
Excel Vers. ve Dili
2007 Office, Tr
Send komutunu bilerek koymamıştık. Belki ön izleme yapmak gerekir diye. Ama şimdi koyalım.
.Send 'Bu satır gönderir. İsterseniz yine pasif yaparsınız.
Bir de gönderilen satırı başlıksız almışız. Başlık konursa daha anlaşılır olur gibi. Şimdiki kodda başlık da ekleniyor.

Kod:
Sub SeciliAlaniMailAtmakYenison()
'Exceldeki sayfadaki son satırı mail gövdesine yapıştırıp mail atar..
'Satır başlıkları da dahil edildiler.
Dim oOutlookApp As Object, oItem As Object, olInsp As Object
Dim wdDoc As Object, oRng As Object
Dim xlRng As Range
Dim SonS As Long

Set oOutlookApp = CreateObject("Outlook.Application")
Set oItem = oOutlookApp.createitem(0)
SonS = Worksheets("ARŞİV").Cells(Rows.Count, "K").End(3).Row

    With oItem
        .display
        .BodyFormat = 2
        .To = "filanca@mail.com;filanca@mail.com"
        .Subject = "Ekli satırların gönderimi"
Set xlRng = Worksheets("ARŞİV").Range("B7:K7")
xlRng.Copy
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.collapse 1
        oRng.Text = "Mail gövdesine yazmak istediğin cümle varsa buraya yaz" & vbCrLf & " "
        oRng.collapse 0
        oRng.Paste

Set xlRng = Worksheets("ARŞİV").Range("B" & SonS & ":K" & SonS)
xlRng.Copy
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.collapse 0
        oRng.Text = " " & vbCrLf & " " & vbCrLf & "Mail gövdesi sonuna yazmak istediğin cümle varsa buraya yaz"
        oRng.Paragraphs(1).Range.Paste
        Application.CutCopyMode = False
        .Send
    End With

    Set oItem = Nothing
    Set oOutlookApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set xlRng = Nothing
End Sub
 

muzos80

Altın Üye
Katılım
21 Aralık 2013
Mesajlar
45
Excel Vers. ve Dili
2013 - Türkçe
Oldu ama bizde gönder dedikten sonra şirket içi yada dışı seçenekleri veriyor outlook orda kalıyor ama çıkan uyarıyada cancel denildiğinde yine de gönderiyor eline sağlık çok teşekkür ederim
 
Katılım
20 Şubat 2007
Mesajlar
503
Excel Vers. ve Dili
2007 Office, Tr
Şirket içi yada dışı seçenekleri konusunda bilgim yok ama kodun işe yaramasına memnun oldum.
 
Üst