- Katılım
- 9 Ağustos 2007
- Mesajlar
- 5
- Excel Vers. ve Dili
- türkçe, 2003
Merhaba arkadaşlar,
Sizden ricam altta kodlarını verdiğim makroda bana yardımcı olmanız hususundadır. İnternetten araştırmalarım sonucunda muhasebecilerin baş belası ba-bs formunu excelldeki verilerden her müşteriye otomatik olarak yollamamız için oluşturduğum excell formatı ekte bulunmaktadır.
Fakat sorun şu ki, henüz vakıf olamadığım kodlamalar hususunda tıkandım. maili otomatik gönderirken;
ilk başta BA-BS mutabakatı diye bir başlık
Bizim firma ünvanımız = (karşılığını excelden direkt alsın) [birden fazla firma için]
altta müşteri/bayi adı= (karşılığını excelden direkt alsın)
vergi dairesi= (karşılığını excelden direkt alsın)
vergi no= (karşılığını excelden direkt alsın)
ba fatura adeti= (karşılığını excelden direkt alsın)
ba fatura tutarı= (karşılığını excelden direkt alsın)
bs fatura adeti= (karşılığını excelden direkt alsın)
bs fatura tutarı= (karşılığını excelden direkt alsın)
en altta yine bilgilendirme notu
olsun istedim.
fakat ekteki dosyadaki örnek mailde bile altta bulunan başlığı üste alamadım.
sorunu nasıl çözebilirim? yahut bu kodlar hakkında hangi kaynaktan detaylı bilgi alabilirim?
Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
Option Explicit
Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Ba/Bs Mutabakatı"
.Body = "Bayi/Müşteri Adı:" & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & _
" Mal ve Hizmet Alımlarına / Satımlarına İlişkin Bilgilendirme Notu "
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Sizden ricam altta kodlarını verdiğim makroda bana yardımcı olmanız hususundadır. İnternetten araştırmalarım sonucunda muhasebecilerin baş belası ba-bs formunu excelldeki verilerden her müşteriye otomatik olarak yollamamız için oluşturduğum excell formatı ekte bulunmaktadır.
Fakat sorun şu ki, henüz vakıf olamadığım kodlamalar hususunda tıkandım. maili otomatik gönderirken;
ilk başta BA-BS mutabakatı diye bir başlık
Bizim firma ünvanımız = (karşılığını excelden direkt alsın) [birden fazla firma için]
altta müşteri/bayi adı= (karşılığını excelden direkt alsın)
vergi dairesi= (karşılığını excelden direkt alsın)
vergi no= (karşılığını excelden direkt alsın)
ba fatura adeti= (karşılığını excelden direkt alsın)
ba fatura tutarı= (karşılığını excelden direkt alsın)
bs fatura adeti= (karşılığını excelden direkt alsın)
bs fatura tutarı= (karşılığını excelden direkt alsın)
en altta yine bilgilendirme notu
olsun istedim.
fakat ekteki dosyadaki örnek mailde bile altta bulunan başlığı üste alamadım.
sorunu nasıl çözebilirim? yahut bu kodlar hakkında hangi kaynaktan detaylı bilgi alabilirim?
Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
Option Explicit
Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Ba/Bs Mutabakatı"
.Body = "Bayi/Müşteri Adı:" & cell.Offset(0, -1).Value & vbNewLine & vbNewLine & _
" Mal ve Hizmet Alımlarına / Satımlarına İlişkin Bilgilendirme Notu "
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
