farklı kaydet ile dosya ismini hücreden aldırmak

[kneehot]

selamlar arkadaşlar. Asagıdakı formulu sızden almıstım ve kendıme gore bıraz guncelledım fakat beceremedıgım dosyayı kaydedıp gonderıyor onun yerıne AK6 hucresındeki yazıyı dosya adı olarak alıp ornegın c:\siparisler klasörüne farklı kaydedıp gondermesı.yardımcı olursanız coksevınırım. tum yardımlara tesekkurler.




Sub OutlookMsgGönder()
Dim app As Outlook.Application
Dim posta As Outlook.MailItem
Dim MyFile As String

ActiveWorkbook.Save
MyFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

Set app = CreateObject("Outlook.Application")
Set posta = app.CreateItem(olMailItem)
With posta
.To = [ea1] & ";" & [ea2] & ";" & [ea3]
'.BCC =
.Subject = Now & " " & [n6] & " SİPARİŞ FORMU"
.Body = "Merhaba;" & Chr(13) & Chr(13) & Now & " tarihli " & [n6] & " " & [bi6] & " adet" & " sipariş ektedir." & Chr(13) & Chr(13) & "İyi Çalışmalar."
.Attachments.Add MyFile
'.Display'Bu satırı kapatıp
.Send 'bu satırı açın.
Application.DisplayAlerts = True
End With
MsgBox "MAIL GÖNDERİLDİ.!!", vbOKOnly
Application.ScreenUpdating = True

Set app = Nothing
Set posta = Nothing
'**********************************************************************
'Referanslardan Microsoft Outlook X.X Object Library seçili olmalıdır.*
'**********************************************************************
End Sub

 

[kneehot]

arkadaslar bunun cok zor bısey olmadıgını dusunuyorum eger zorsa ya da yapılamaz bırseyse soyleyın lutfen bosa beklemıyım.

 

[halit3]

Mail göndermeden bek anlamam ama aşağıdaki kodu bir denermiziniz.

Sub OutlookMsgGönder()
Dim app As Outlook.Application
Dim posta As Outlook.MailItem
Dim MyFile As String
uzanti = Right(ActiveWorkbook.Name, InStr(1, StrReverse(ActiveWorkbook.Name), ".", vbTextCompare))
MyFile = "c:\siparisler\" & Range("AK6").Value & uzanti
'----------------------------------------------
ActiveWorkbook.SaveAs MyFile
Set app = CreateObject("Outlook.Application")
Set posta = app.CreateItem(olMailItem)
With posta
.To = [ea1] & ";" & [ea2] & ";" & [ea3]
'.BCC =
.Subject = Now & " " & [n6] & " SİPARİŞ FORMU"
.Body = "Merhaba;" & Chr(13) & Chr(13) & Now & " tarihli " & [n6] & " " & [bi6] & " adet" & " sipariş ektedir." & Chr(13) & Chr(13) & "İyi Çalışmalar."
.Attachments.Add MyFile
'.Display'Bu satırı kapatıp
.Send 'bu satırı açın.
Application.DisplayAlerts = True
End With
MsgBox "MAIL GÖNDERİLDİ.!!", vbOKOnly
Application.ScreenUpdating = True
Set app = Nothing
Set posta = Nothing
'************************************************* *********************
'Referanslardan Microsoft Outlook X.X Object Library seçili olmalıdır.*
'************************************************* *********************
End Sub

Ben sadece bu bölümü ekledim.

uzanti = Right(ActiveWorkbook.Name, InStr(1, StrReverse(ActiveWorkbook.Name), ".", vbTextCompare))
MyFile = "c:\siparisler\" & Range("AK6").Value & uzanti
'----------------------------------------------
ActiveWorkbook.SaveAs MyFile

Not: AK6 hücresine sadece dosya adını yazın

 

[kneehot]

cok tesekkurler gercekten tam istedigim gibi calısıyor. tekrar cok tesekkur ederım.

 

[halit3]

cok tesekkurler gercekten tam istedigim gibi calısıyor. tekrar cok tesekkur ederım.

İyi çalışmalar