Yazdırma alanı PDF ve EXCEL dosyası olarak mail gönderme

[ozgurpeh]

Merhaba, aşağıdaki kod PDF olarak oluşuyorsa aynı mantıkla XLS yaparsam excel ek olarak mail gitmesi gerekmez mi ?

Sub Mail()
Dim Makro As Object
Dim Mail As Object
Set Makro = CreateObject("Outlook.Application")
Set Mail = Makro.CreateItem(0)
Dim yol As String
yol = Application.ActiveWorkbook.Path & "\"
ek = yol & Sheet1.Range("H1").Text & ".pdf"
Sheets("Form").Range("A1:X49").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ek, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
On Error Resume Next

 

[Korhan Ayhan]

Excel olarak nasıl kayıt ediyorsunuz?

 

[ozgurpeh]

Yine xls


Tapatalk kullanarak iPhone aracılığıyla gönderildi

 

[Korhan Ayhan]

Kullandığınız kodu istemiştim...

 

[ozgurpeh]

Kullandığınız kodu istemiştim...

Kodun tamamı aşağıda, H1 hücresinde yazan değerle ("A1:X49) alanını PDF olarak maile atıyor. bu kod ben aynı mantıkla excel ek olarak atsın istiyorum.

Sub Mail()
Dim Makro As Object
Dim Mail As Object
Set Makro = CreateObject("Outlook.Application")
Set Mail = Makro.CreateItem(0)
Dim yol As String
yol = Application.ActiveWorkbook.Path & "\"
ek = yol & Sheet1.Range("H1").Text & ".pdf"
Sheets("Form").Range("A1:X49").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ek, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
On Error Resume Next
With Mail
.To = Sheets("gir").Range("AL45")
.CC = Sheets("gir,").Range("AL46")
.Subject = Sheets("Form").Range("R7")
.Body = "ektedir" & Chr(10) & Chr(10) & "" & Chr(13) & Chr(13) & "Tesekkürler."
.Attachments.Add ek
.Display
'.Send
'MsgBox "."

End With
On Error GoTo 0
Set Mail = Nothing
Set Makro = Nothing
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Mail()
    Dim Makro As Object
    Dim Mail As Object
    Dim Yol As String, Dosya As String
   
    Set Makro = CreateObject("Outlook.Application")
    Set Mail = Makro.CreateItem(0)
   
    Yol = Application.ActiveWorkbook.Path & "\"
    Dosya = Yol & "Dosya_Adınız.xls"
   
    Sheets("Form").Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Dosya, 56
    Windows("Dosya_Adınız.xls").Close
    Application.DisplayAlerts = True
   
    On Error Resume Next
   
    With Mail
        .To = Sheets("gir").Range("AL45")
        .CC = Sheets("gir,").Range("AL46")
        .Subject = Sheets("Form").Range("R7")
        .Body = "ektedir" & Chr(10) & Chr(10) & "" & Chr(13) & Chr(13) & "Tesekkürler."
        .Attachments.Add Dosya
        .Display
        '.Send
        'MsgBox "."
    End With
   
    On Error GoTo 0
   
    Set Mail = Nothing
    Set Makro = Nothing
End Sub

 

[ozgurpeh]

Deneyiniz.

Option Explicit

Sub Mail()
    Dim Makro As Object
    Dim Mail As Object
    Dim Yol As String, Dosya As String
  
    Set Makro = CreateObject("Outlook.Application")
    Set Mail = Makro.CreateItem(0)
  
    Yol = Application.ActiveWorkbook.Path & "\"
    Dosya = Yol & "Dosya_Adınız.xls"
  
    Sheets("Form").Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Dosya, 56
    Windows("Dosya_Adınız.xls").Close
    Application.DisplayAlerts = True
  
    On Error Resume Next
  
    With Mail
        .To = Sheets("gir").Range("AL45")
        .CC = Sheets("gir,").Range("AL46")
        .Subject = Sheets("Form").Range("R7")
        .Body = "ektedir" & Chr(10) & Chr(10) & "" & Chr(13) & Chr(13) & "Tesekkürler."
        .Attachments.Add Dosya
        .Display
        '.Send
        'MsgBox "."
    End With
  
    On Error GoTo 0
  
    Set Mail = Nothing
    Set Makro = Nothing
End Sub

Burda siz Form sayfasını copy yapmışsınız oysa ben Sheets("Form").Range("A1:X49") alanını ek olarak koymak istiyorum

 

[Korhan Ayhan]

Özgür Bey,

"FORM" sayfasında bu alan dışında veriler varsa kopyalama işleminden sonra silinerek kayıt edilebilir.

Bunun dışında kod sağlıklı çalıştı mı?

 

[ozgurpeh]

Özgür Bey,

"FORM" sayfasında bu alan dışında veriler varsa kopyalama işleminden sonra silinerek kayıt edilebilir.

Bunun dışında kod sağlıklı çalıştı mı?

Gayet başarılı, teşekkürler


Tapatalk kullanarak iPhone aracılığıyla gönderildi