Makro sorunu

[KARTAL133]

Merhaba Arkadaşlar

Aşağıdaki makorda sorun yasıyorum yardımlarını rica ederim şimdiden teşekkürler

Sub MAIL_GONDER()
Dim S1 As Worksheet, S2 As Worksheet
Dim Uygulama As Object, Yeni_Mail As Object
Dim Yol As String, X As Long, Son As Long

Yol1 = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Gönderilen Ekstreler"
Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Fatura Ekstreler1"

If Dir(Yol, vbDirectory) = "" Then
On Error Resume Next
MkDir Yol
On Error GoTo 0
End If

Set S1 = Sheets("Mailinfo")
Set S2 = Sheets("FilterExample")
Set S3 = Sheets("imza")
Set S4 = Sheets("Genel Bilgiler")


Son = S1.Cells(S1.Rows.Count, 1).End(3).Row

For X = 4 To Son
If S1.Cells(X, "I") = "" Then
S2.Range("H7") = S1.Cells(X, 1)

Dosya_Adi1 = S1.Cells(X, 2).Value & " " & S4.Range("C6") & " - " & S4.Range("c7") & ".pdf"

S2.Range("Print_Area").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Yol1 & "\" & Dosya_Adi1, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Dosya_Adi = S1.Cells(X, 3).Value & ".pdf"

If kontrol = 1 Then
Dosya_Adi = S1.Cells(X, 3).Value & " " & S4.Range("C6") & " - " & S4.Range("c7") & ".pdf"
S3.Range("Print_Area").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Yol & "\" & Dosya_Adi, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If

Set Uygulama = CreateObject("Outlook.Application")
Set Yeni_Mail = Uygulama.CreateItem(0)

With Yeni_Mail
.CC = S4.Range("c8").Value ' Bilgi
.Subject = S4.Range("c5").Value ' konu
.body = S3.Range("a1").Value
.Attachments.Add Yol & "\" & Dosya_Adi
.Attachments.Add Yol1 & "\" & Dosya_Adi1
.Save
.To = S1.Cells(X, 10).Value
.Send
End With
End If
Next

MsgBox "Mail gitti."

Set Uygulama = Nothing
Set Yeni_Mail = Nothing
End Sub

 

[YUSUF44]

Bari ne sorun olduğunu belirtseydiniz!

 

[KARTAL133]

Doysa Yolu bulunamadı diyor

 

[PLİNT]

Doysa Yolu bulunamadı diyor

Merhaba
İlk göze çarpan

  Yol1 = CreateObject("WScript.Shell").SpecialFolders("[COLOR="Red"]Desk top[/COLOR]") & "\Gönderilen Ekstreler"
Yol = CreateObject("WScript.Shell").SpecialFolders("[COLOR="Red"]Desk top[/COLOR]") & "\Fatura Ekstreler1"

"Desktop" şeklinde bitişik olmalı. Tırnak içinde olduğu için otomatik birleşmeyecektir.

 

[KARTAL133]

ne yazık ki olmadı ben sana dosyayı atyım

 

[KARTAL133]

ek

Merhaba Dosya Ektedir.

 

[KARTAL133]

ek

doysa ektedir.