Új hozzászólás Aktív témák

• #11930 total90 támogató

  Új Válasz 2018-04-25 09:09:50 #11930

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  total90

  támogató

  Jönnék megint valamivel

  VBA Access

  A program megnyitja az Outlookot, majd egy adott mappa (VBATest) tartalmát egy adatbázisba/tabellába írja. Ide kerül(ne) minden ami az emailben van, tehát feladó, CC, BCC, ki kapja ez emailt, a levél tárgya... majd ha melléklet van, akkor azt lementi egy mappába.

  A kód maga:

  Option Compare Database
Option Explicit

Public Sub TestAccessDB_Outlook()


Dim db As DAO.Database, rs As DAO.Recordset
Dim objOutlook As Outlook.Application, objNameSpace As Outlook.NameSpace
Dim objMailordner As Outlook.MAPIFolder
Dim objGAINMailordner As Outlook.MAPIFolder
Dim objAttachment As Outlook.Attachment, objMail As Outlook.Items
Dim objEMail As Outlook.MailItem
Dim intCtr As Integer

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM tbl_Email_Log;")
Set objOutlook = New Outlook.Application
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objMailordner = objNameSpace.GetDefaultFolder(olFolderInbox)
Set objGAINMailordner = objMailordner.Folders("VBATest")
Set objMail = objGAINMailordner.Items

For Each objEMail In objMail
rs.AddNew
rs.Fields("Targy") = objEMail.Subject
rs.Fields("Mellekletszama") = objEMail.Attachments.Count
rs.Fields("Emailtulaj") = objEMail.ReceivedByName
rs.Fields("Ido") = objEMail.ReceivedTime
rs.Fields("Emailkuldo") = objEMail.ReplyRecipientNames
rs.Fields("BCC") = objEMail.BCC
rs.Fields("CC") = objEMail.CC
rs.Fields("Tartalom") = objEMail.Body
rs.Update
Next objEMail

For intCtr = 1 To objGAINMailordner.Items.Count
For Each objAttachment In objGAINMailordner.Items(intCtr).Attachments
objAttachment.SaveAsFile "C:\Users\user\Documents\" & objAttachment.FileName

Next objAttachment
Next intCtr

Forms!frm_Test.txt_Test = Forms!frm_Test.txt_Test & "A mappa üres" & vbNewLine


Set objAttachment = Nothing
Set objMail = Nothing
Set objMailordner = Nothing
Set objGAINMailordner = Nothing
Set objNameSpace = Nothing
objOutlook.Quit
Set objOutlook = Nothing

End Sub

  Van 2 dolog, amiben "hibázik" a program. Az első, hogy nem ismeri fel, hogy kitől kaptam az emailt. Ha nyomok egy debugot, akkor csak kiírja, hogy a mező üres, holott nem az.

  A másik, hogy ha az email tartalmába egy link szerepel, akkor azt nem tudja kezelni. Tehát html-t nem kezel.

  Van valami ötletetek?

Új hozzászólás Aktív témák