- Katılım
- 24 Nisan 2005
- Mesajlar
- 3,652
- Excel Vers. ve Dili
- Office 2016 EN 64 Bit
- Altın Üyelik Bitiş Tarihi
- 25/05/2022
Merhaba,
Outlook da gönderilen her maile aşağıdaki şekilde referans numarası eklenebilir.
Kayıt defterinde referans numarası bulunmuyor ise 0000000 kodunu kayıt eder ve her mail gönder işlemi yapıldığında bu numarayı arttırır.
Mail giden kutusuna düştüğünde program kayıt defterine son numarayı kaydeder.
Outlook da makroların etkinleştirilmiş olması gerekiyor. Kodları ekledikten sonra VBA bölümünde kayıt ikonunu tıklayın. Outlook u kapatıp açın.
REF:XXXXXXX@-AHM XXXXXXXXX/XXXXXXX X dışındaki alanlar sabit alanlardır. Siz ihtiyacınıza göre numarastr değişkenindeki tanımlamaları değiştirebilirsiniz.
REF:0000001@-AHM 9.02.2021/23:23:23
REF:0000002@-AHM 9.02.2021/23:24:03
REF:0000003@-AHM 9.02.2021/23:25:01
Bu kodu ThisOutlookSession bölümüne kaydediniz.
Sıra numarası arttırma, kayıt defterinden okuma ve kayıt defterine yazma işlemleri.
Outlook da gönderilen her maile aşağıdaki şekilde referans numarası eklenebilir.
Kayıt defterinde referans numarası bulunmuyor ise 0000000 kodunu kayıt eder ve her mail gönder işlemi yapıldığında bu numarayı arttırır.
Mail giden kutusuna düştüğünde program kayıt defterine son numarayı kaydeder.
Outlook da makroların etkinleştirilmiş olması gerekiyor. Kodları ekledikten sonra VBA bölümünde kayıt ikonunu tıklayın. Outlook u kapatıp açın.
REF:XXXXXXX@-AHM XXXXXXXXX/XXXXXXX X dışındaki alanlar sabit alanlardır. Siz ihtiyacınıza göre numarastr değişkenindeki tanımlamaları değiştirebilirsiniz.
REF:0000001@-AHM 9.02.2021/23:23:23
REF:0000002@-AHM 9.02.2021/23:24:03
REF:0000003@-AHM 9.02.2021/23:25:01
Bu kodu ThisOutlookSession bölümüne kaydediniz.
C#:
Private Sub Application_Startup()
Set m_Explorer = Application.ActiveExplorer
End Sub
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Asri Akdeniz - asriakdeniz@gmail.com - www.asriakdeniz.com
'Güncel tarih bilgisi alınıyor
tarih = Date
'Güncel saat bilgisi alınıyor
saat = Time
'Mailin içeriğinin ilk 4 karakteri REF: ise mailde referans kodu var demektir. Ayrıca referans kodu eklenmez.
If Left(Item.Body, 4) <> "REF:" Then
On Error Resume Next
'Sıra numarası (referans sıra numarası) kayıt defterinden okunuyor.
sirano = regoku("SiraNumarasi")
On Error GoTo 0
'Sıra numarası (referans sıra numarası) bir arttırılıyor.
sirano = numarator(sirano)
'Referans numarası oluşturuluyor.
numarastr = "REF:" & sirano & "@-AHM " & tarih & "/" & saat
'Mail konusunun başına referans kodu ekleniyor.
'Item.Subject = numarastr & " " & Item.Subject
'Metin tabanlı mail içeriğinin başına referans kodu ekleniyor.
'Item.Body = numarastr & " " & Item.Body
'HTML tabanlı mail içeriğinin başına referans kodu ekleniyor.
Item.HTMLBody = numarastr & " " & Item.HTMLBody
On Error Resume Next
'Arttırılmış olan sıra numarası kayıt defterine kaydediliyor.
Call regkaydet("SiraNumarasi", sirano)
On Error GoTo 0
End If
End SubSıra numarası arttırma, kayıt defterinden okuma ve kayıt defterine yazma işlemleri.
C#:
Dim veri() As String
Dim adet As Long
Dim elde, bakilansayi As Boolean
Const harfler As String = "ABCDEFGĞHIİJKLMNOÖPRSŞTUÜXWVYZ"
Const sayilar As String = "0123456789"
'Const sayilar As String = "01"
Const dahildegil As String = ".-/"
Public sirano As String
'Asri Akdeniz - asriakdeniz@gmail.com - www.asriakdeniz.com
Function numarator(numara) As String
numara = StrReverse(numara)
adet = Len(numara)
ReDim Preserve veri(1 To adet)
For i = 1 To adet
veri(i) = Mid(numara, i, 1)
Next i
elde = False
For j = LBound(veri) To UBound(veri)
harf = veri(j)
If InStr(dahildegil, harf) > 0 Then GoTo son
bakilansayi = sayimi(harf)
If bakilansayi Then
veri(j) = sayiarttir(harf)
Else
veri(j) = harfarttir(harf)
End If
If elde = False Then
Exit For
End If
son:
Next j
For i = LBound(veri) To UBound(veri)
veristr = veristr & veri(i)
Next i
veristr = StrReverse(veristr)
If Left(veristr, 1) = Left(sayilar, 1) And elde Then
numarator = "1" & veristr
ElseIf Left(veristr, 1) = Left(harfler, 1) And elde Then
numarator = Left(harfler, 1) & veristr
Else
numarator = veristr
End If
End Function
Function harfarttir(harfstr) As String
mevcutsira = InStr(harfler, harfstr)
yenisira = Mid(harfler, mevcutsira + 1, 1)
If yenisira = "" Then
harfarttir = Mid(harfler, 1, 1)
elde = True
Else
harfarttir = yenisira
elde = False
End If
End Function
Function sayiarttir(sayistr) As String
mevcutsira = InStr(sayilar, sayistr)
yenisira = Mid(sayilar, mevcutsira + 1, 1)
If yenisira = "" Then
sayiarttir = Mid(sayilar, 1, 1)
elde = True
Else
sayiarttir = yenisira
elde = False
End If
End Function
Function sayimi(sadecesayistr)
liste = "0123456789"
For k = 1 To Len(sadecesayistr)
harf = Mid(sadecesayistr, k, 1)
If InStr(liste, harf) = 0 Then
sayimi = False
Exit Function
End If
Next k
sayimi = True
End Function
Sub regkaydet(regisim As String, regveri As String)
On Error Resume Next
CreateObject("WScript.Shell").RegWrite "HKCU\Software\OutlookRefNo\" & regisim, regveri, "REG_SZ"
If regisim = "ozelsecimtasikarakter" Then
a = a
End If
If regveri = "" Then
CreateObject("WScript.Shell").RegDelete "HKCU\Software\OutlookRefNo\" & regisim
End If
On Error GoTo 0
End Sub
Function regoku(regisim As String) As String
On Error Resume Next
regoku = CreateObject("WScript.shell").Regread("HKCU\Software\OutlookRefNo\" & regisim)
If regoku = "" And regisim = "SiraNumarasi" Then regoku = "0000000"
On Error GoTo 0
End Function
