tirEdsOuL
Altın Üye
- Katılım
- 3 Şubat 2009
- Mesajlar
- 326
- Excel Vers. ve Dili
- Office 2016
- Altın Üyelik Bitiş Tarihi
- 24-08-2026
Arkadaşlar Merhaba;
Hergün düzenli olarak gelen maillerimden konu alanında bulunan bazı yerleri belirteceğim tarihten itibaren 3ncü satırdan başlayarak yazdırmak istiyorum.
C3'den itibaren tarih karakter uzunluğu sabit
D3'den itibaren sipariş no karakter uzunluğu sabit
E3'den itibaren paket karakter uzunluğu değişken
Sabit konu alanı : "POLAR: ARAÇ BİLDİRİMİ ALIM ONAYINIZI BEKLİYOR. - Bayi: Abcdef - Sipariş: 5658115919 - Paket: Select 548O - Son Tarih: 07.02.2017 01:00:00"
-----
Outlook'a gelen mailleri excele yazdırmak için bayramdede.com adresinden aşağıdaki gibi kod buldum ama bu kodda tarih aralığı olmadığı için tüm mailleri listeliyor.
Bu tarih problemi için de aynı kod üzerinden forumda u.L.a.s arkadaşımız bir konu açmış ama sonuca bağlanamamış.
Aşağıdaki koda tarih aralığı belirtebilirsek, sadece konu alanındaki istediğim alanları ilgili hücrelere yazdırmak kalacak.
Hergün düzenli olarak gelen maillerimden konu alanında bulunan bazı yerleri belirteceğim tarihten itibaren 3ncü satırdan başlayarak yazdırmak istiyorum.
C3'den itibaren tarih karakter uzunluğu sabit
D3'den itibaren sipariş no karakter uzunluğu sabit
E3'den itibaren paket karakter uzunluğu değişken
Sabit konu alanı : "POLAR: ARAÇ BİLDİRİMİ ALIM ONAYINIZI BEKLİYOR. - Bayi: Abcdef - Sipariş: 5658115919 - Paket: Select 548O - Son Tarih: 07.02.2017 01:00:00"
-----
Outlook'a gelen mailleri excele yazdırmak için bayramdede.com adresinden aşağıdaki gibi kod buldum ama bu kodda tarih aralığı olmadığı için tüm mailleri listeliyor.
Bu tarih problemi için de aynı kod üzerinden forumda u.L.a.s arkadaşımız bir konu açmış ama sonuca bağlanamamış.
Aşağıdaki koda tarih aralığı belirtebilirsek, sadece konu alanındaki istediğim alanları ilgili hücrelere yazdırmak kalacak.
Kod:
Option Explicit
Private lRow As Long, x As Date, oWS As Worksheet
Sub GetFromInbox()
Const olFolderInbox = 6
Dim olApp As Object, olNs As Object
Dim oRootFldr As Object
Dim lCalcMode As Long
Set olApp = CreateObject("Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set oRootFldr = olNs.GetDefaultFolder(olFolderInbox) '.Folders(InputBox("Maillerin bulunduğu klasörü giriniz", "BDD"))
Set oWS = ActiveSheet
x = Date
lRow = 2
lCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
GetFromFolder oRootFldr
' Application.ScreenUpdating = True
Application.Calculation = lCalcMode
Set oWS = Nothing
Set oRootFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Private Sub GetFromFolder(oFldr As Object)
Dim oItem As Object, oSubFldr As Object
For Each oItem In oFldr.Items
Range("g1").Value = lRow
If TypeName(oItem) = "MailItem" Then
With oItem
' If .Subject = "Is Goremezlik Raporu" Then
oWS.Cells(lRow, 1).Value = .SenderName
oWS.Cells(lRow, 2).Value = .to
oWS.Cells(lRow, 3).Value = .cc
oWS.Cells(lRow, 4).Value = .Subject
oWS.Cells(lRow, 5).Value = .ReceivedTime
oWS.Cells(lRow, 6).Value = .body
lRow = lRow + 1
' If lRow = 10 Then Exit Sub
' End If
End With
End If
Next
' Recurse all Subfolders
For Each oSubFldr In oFldr.Folders
GetFromFolder oSubFldr
Next
End Sub
Ekli dosyalar
-
59.4 KB Görüntüleme: 19