- Katılım
- 10 Temmuz 2020
- Mesajlar
- 33
- Excel Vers. ve Dili
- 2010 - Türkçe
arkadaşlar benim excel'de çari takibi tutuyorum
Bir Ana Sayfa var her firmayada bir sayfa ayırdım bu sayfaları PDF cevirip mail atabiliyorum aşagıdaki kodla ( koduda aramalar sonucunda burda buldum
)
fakat benim iki istegim olacak
birincisi Boş Olan hücreleri yazmaya eklemesin
birde mail adresini firmaın mail adresi yazılı olan h5 hücresinden alsın böyle birşey mümkün müdür ?
Sub MailGonder()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Title = Range("A1")
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
With OutlApp.CreateItem(0)
.Subject = Title
.To = "mailadresi" ' Kime
.CC = "mailadresi" ' bilgi olarak kime
.Body = "Selamun aleykum," & vbLf & vbLf _
& "Bu rapor PDF rapor içermektedir." & vbLf & vbLf _
& "Hayirli gunler" & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail gonderilemedi", vbExclamation, "zaza"
Else
MsgBox "E-mail gonderildi", vbInformation, "zaza"
End If
On Error GoTo 0
End With
Kill PdfFile
If IsCreated Then OutlApp.Quit
Set OutlApp = Nothing
End Sub
Bir Ana Sayfa var her firmayada bir sayfa ayırdım bu sayfaları PDF cevirip mail atabiliyorum aşagıdaki kodla ( koduda aramalar sonucunda burda buldum
)fakat benim iki istegim olacak
birincisi Boş Olan hücreleri yazmaya eklemesin
birde mail adresini firmaın mail adresi yazılı olan h5 hücresinden alsın böyle birşey mümkün müdür ?
Sub MailGonder()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Title = Range("A1")
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
With OutlApp.CreateItem(0)
.Subject = Title
.To = "mailadresi" ' Kime
.CC = "mailadresi" ' bilgi olarak kime
.Body = "Selamun aleykum," & vbLf & vbLf _
& "Bu rapor PDF rapor içermektedir." & vbLf & vbLf _
& "Hayirli gunler" & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail gonderilemedi", vbExclamation, "zaza"
Else
MsgBox "E-mail gonderildi", vbInformation, "zaza"
End If
On Error GoTo 0
End With
Kill PdfFile
If IsCreated Then OutlApp.Quit
Set OutlApp = Nothing
End Sub
