- Katılım
- 13 Mart 2015
- Mesajlar
- 7
- Excel Vers. ve Dili
- Türkçe
Merhaba
Mutabakat için excel ile outlook üzerinden mektup gönderiyordum. Bilgi işlem de çalışan eski arkadaş makroyu oluşturmuştu. Bilgisayarım yenilendiğinde birşeyler ters gitmeye başladı. E posta doğru gidiyor ancak "Konu" alanı boş kalıyor. Bunun nedeni ve çözümü için yardımınızı rica ederim. Excel ekran görüntüsü, outlook ekran görüntülerini ve makro dizinini aşağıya ekledim.
Makro çalışma süreci.
1- Excel Sheet1 sayfasına mutabakat yapmak istediğim firmaların bilgisini giriyorum. Ünvan, vergi numarası, e posta adresi.
2- Mutabakat pdf leri C:\BA Mutabakat Mektupları klasörüne koyuyorum.
3- E posta metni Sheet1 sayfasında D1 hücresi
4- Excel Sheet1 sayfasında Gönder ikonunu tıkladığımda aşağıda ekran görüntüsünde göreceğiniz şekilde mektupları gönderiyordum.
Tşk
Sub Mail_atici()
' E-mail sender to restaruants.
'
' Revision History
' [09.03.2012] [kayhany] script created for single email.
' [12.03.2012] [kayhany] Loop added for email addresses at col. A, parametric message enabled for col. B.
'
'
Dim OutApp As Object
Dim OutMail As Object
Dim sayac As Integer
Dim SigString As String
Dim Signature As String
sayac = 1
'Change only Mysig.txt to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Genel.txt"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Loop for sending mails
With OutMail
.To = cell.Value
.CC = ""
.BCC = ""
.Subject = Columns("B").Cells(sayac)
.Body = Columns("D").Cells("1") & vbNewLine & vbNewLine & Signature
'.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
.Attachments.Add ("C:\BA Mutabakat Mektupları\" & Columns("B").Cells(sayac) & "-" & Columns("C").Cells(sayac) & ".PDF")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
sayac = sayac + 1
Next cell
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
[url=https://hizliresim.com/6Do0kv]
[/URL]
Mutabakat için excel ile outlook üzerinden mektup gönderiyordum. Bilgi işlem de çalışan eski arkadaş makroyu oluşturmuştu. Bilgisayarım yenilendiğinde birşeyler ters gitmeye başladı. E posta doğru gidiyor ancak "Konu" alanı boş kalıyor. Bunun nedeni ve çözümü için yardımınızı rica ederim. Excel ekran görüntüsü, outlook ekran görüntülerini ve makro dizinini aşağıya ekledim.
Makro çalışma süreci.
1- Excel Sheet1 sayfasına mutabakat yapmak istediğim firmaların bilgisini giriyorum. Ünvan, vergi numarası, e posta adresi.
2- Mutabakat pdf leri C:\BA Mutabakat Mektupları klasörüne koyuyorum.
3- E posta metni Sheet1 sayfasında D1 hücresi
4- Excel Sheet1 sayfasında Gönder ikonunu tıkladığımda aşağıda ekran görüntüsünde göreceğiniz şekilde mektupları gönderiyordum.
Tşk
Sub Mail_atici()
' E-mail sender to restaruants.
'
' Revision History
' [09.03.2012] [kayhany] script created for single email.
' [12.03.2012] [kayhany] Loop added for email addresses at col. A, parametric message enabled for col. B.
'
'
Dim OutApp As Object
Dim OutMail As Object
Dim sayac As Integer
Dim SigString As String
Dim Signature As String
sayac = 1
'Change only Mysig.txt to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Genel.txt"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Loop for sending mails
With OutMail
.To = cell.Value
.CC = ""
.BCC = ""
.Subject = Columns("B").Cells(sayac)
.Body = Columns("D").Cells("1") & vbNewLine & vbNewLine & Signature
'.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
.Attachments.Add ("C:\BA Mutabakat Mektupları\" & Columns("B").Cells(sayac) & "-" & Columns("C").Cells(sayac) & ".PDF")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
sayac = sayac + 1
Next cell
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
[url=https://hizliresim.com/6Do0kv]
[/URL]
Son düzenleme:
