Outlook ile değişken isimli dosya göndermek

[stelci]

Merhaba,

Edindiğim iki ayrı makroyu biraz değiştirip biraz da record ederek, ihtiyacımı karşılayacak bir makro oluşturdum. Makrom birden fazla sheet'i olan bir dosyadan belirli bir ya da bir kaç sheet'i çıkartıp outlook kullanarak mail atılmak üzere hazırlıyor. Son yaptığım bir eklentiyle ayırdığı sheet'leri 'dosya_mm_dd_yyy.xls' olarak bir önceki günün tarihi ile save ediyor, ancak bu değişken isimli dosyayı mail eklentisi olarak yapacak kod satırını beceremedim...

Tüm kodu aşağıda yazıyorum; ilgilenebilecek arkadaşlar varsa yardımlarını rica ediyorum...Teşekkürler


.......................................
Sub Mail()

Sheets(Array("sheet1", "sheet2")).Select
Sheets("sheet1").Activate
Sheets(Array("sheet1", "sheet2")).Copy

Sheets("sheet2").Select
Cells.Select
Range("D8").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("D5").Select
Columns("M:O").Select
Selection.Delete Shift:=xlToLeft
Range("C5").Select

Sheets("sheet1").Select
Cells.Select
Range("D8").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("D5").Select

ChDir "C:\..........\mail"
tarih = Format(Now - 1, "dd_mm_yyyy")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:\..........\mail\dosyaadı_" & tarih, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
Application.StatusBar = False
Application.DisplayAlerts = False
Windows("dosyaadı_" & tarih + ".xls").Close False


Windows("Anadosya.xls").Activate
'Sheets("email listesi").Select
Sheets("Anadosya").Select

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range, cellcc As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("email listesi")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
For Each cellcc In sh.Columns("C").Cells.SpecialCells(xlCellTypeConstants)


'Enter the file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

If cell.Value Like "?*@?*.?*" And cellcc.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = cell.Value
.cc = cellcc.Value
.Subject = ".........."
.Body = "" & cell.Offset(0, -1).Value

'Muhtemelen attach etmesi gereken kod satırı burada olacak...

.Display
End With

Set OutMail = Nothing
End If
Next cellcc

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Next

End Sub
............................................