Archiwizacja maili w excel (lub access) + załączniki

Pytania, problemy, uwagi związane ze starszymi wersjami Microsoft Outlook 2003, 2002 (XP), 2000, 98

Moderator: Moderatorzy

Archiwizacja maili w excel (lub access) + załączniki

Postprzez ehret » Pt 20.08.2010 10:18

Witam,
chciałbym wyeksportować folder maili do bazy (np w excelu) gdzie oprócz podstawowych informacji (od, data, dw, treść) byłby również załącznik (lub link do załącznika).
czy jest jakieś rozwiązanie takiej kwestii?
z góry dzięki
ehret
 
Posty: 1
Dołączył(a): Pt 20.08.2010 10:13

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez OShon » Pt 20.08.2010 10:27

Nie da się tego zrobić bezpośrednio, ponieważ załącznik są spakowane w bazę Outlooka Officeowego (plik Outlook.pst);
inaczej niż w Outlook Expresie, gdzie są one częścią katalogów na dysku.
Oczywiście da się wyeksportować załączniki na dysk, ale export do ACC lub Excela wiąże sie z jego dość mocną modyfikacją.
Obrazek
Oskar Shon - MVP Office Dev. 11/21, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 10835
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez amis » So 24.10.2020 17:34

Witam wszystkich

Zapisuję maile makrem w Outlooku do bazy Access.
Wykorzystuję do tego recordset i wszystko niby działa ok.
ale :(

treść maila zapisywana w polu "długi tekst" się strasznie rozwala, ponieważ wstawiane są dodatkowe wiersze.

tekst:
ssssssss
ssssssss

wygląda:
ssssssss

ssssssss


czy można temu zapobiec?
Prośba o pomoc.
Pozdr.,
amis
 
Posty: 8
Dołączył(a): Cz 12.03.2015 20:30

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez OShon » So 24.10.2020 18:47

Jak eksportować wiadomości do ACC wyjaśniam w tym artykule: https://www.outlook.pl/Jak-utworzyc-kopie-wiadomosci-email-regula-w-bazie-Access/509/
Nie wykluczone ze kod jaki masz zapisany w HTMLu dodaje automatycznie Entera.
Zamień zatem 2 i podłącz jednego przy pomocy komendy replace()
Obrazek
Oskar Shon - MVP Office Dev. 11/21, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 10835
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez amis » N 25.10.2020 16:26

Cześć,
Dzięki za podpowiedź niemniej nie zapisuję każdego maila, tylko wybrane, co więcej równocześnie zapisuję i podłączam do bazy załączniki z maila.
Robię to z poziomu otwartego okna z wiadomością i przypisanego do przycisku makra.
Poniżej mój może niezbyt szczęśliwy ale jednak w jakimś stopniu fajnie działający kod.
Jeśli mogę prosić o sugestie w zakresie ulepszenia / poprawy to polecam się

Kod: Zaznacz cały
Sub ZapiszDoBazy()
 
Dim myItem As MailItem
Dim MyData As DataObject
Dim cString As String
Dim oAttach As Attachment, pict As Object, File$, ile&
Dim Od As String
Dim Doo As String
Dim WFile As String
Dim Temat As String
Dim Wiadomosc As String
Dim RszNew As DAO.Recordset
Dim NewZal As DAO.Recordset
Dim Dateczka As String
 
BazaPlik = "Sprawy.mdb"
 
Set RszNew = OpenDatabase(BazaPlik).OpenRecordset("select * from pismo")
Set NewZal = OpenDatabase(BazaPlik).OpenRecordset("select * from Zalaczniki")
 
Set MyData = New DataObject
 
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
        Set myItem = ActiveExplorer.Selection.Item(1)
        myItem.Display
    Case "Inspector"
        Set myItem = ActiveInspector.CurrentItem
    Case Else
End Select
On Error GoTo 0
 
If myItem Is Nothing Then
    MsgBox "Zaznacz wiadomość lub ją otwórz!", vbExclamation, "MS"
    Exit Sub
End If
 
    RszNew.AddNew
    RszNew.Fields("dataPisma") = DateValue(myItem.CreationTime)
    RszNew.Fields("DataOtrzymaniaPisma") = myItem.ReceivedTime
    RszNew.Fields("OsobaProwadząca") = 9
    RszNew.Fields("typsprawy") = 11
    RszNew.Fields("podtypsprawy") = 1
    RszNew.Fields("Etap") = 2
    RszNew.Fields("Nadawca") = 11
    RszNew.Fields("WymaganaOdpowiedz") = True
    RszNew.Fields("dotyczy") = myItem.Subject
    RszNew.Fields("uwagi") = "<- Od: " & myItem.SenderName & "," & myItem.SenderEmailAddress & ", " & myItem.ReceivedTime & " do: " & myItem.To & " ->" & Chr(10) & Chr(13) & Chr(10) & Chr(13) & myItem.Body
    RszNew.Fields("osobarejestrujaca") = Environ("computername") & "_" & Environ("username")
    RszNew.Fields("DataWpisania") = Now()
 
Dateczka = Day(Now) & "_" & Month(Now) & "_" & Year(Now) & "_" & Hour(Now) & "_"
For Each pict In myItem.Attachments
    DoEvents
    Set oAttach = pict
    File = Dateczka & oAttach.FileName
 
    NewZal.AddNew
    NewZal.Fields("Zalacznik") = Dateczka & oAttach.FileName
    NewZal.Fields("KtoRejestrował") = Environ("computername") & "_" & Environ("username")
    NewZal.Fields("DataOstatniejModyfikacji") = Now()
    NewZal.Fields("DataRejestracji") = Now()
    NewZal.Fields("OstanioModyfikowal") = Environ("computername") & "_" & Environ("username")
    NewZal.Fields("IdSprawy") = 919191919
    NewZal.Update
 
    oAttach.SaveAsFile "\\SkanDoc2019\" & File
   
    ile = ile + 1
    WFile = WFile & Dateczka & oAttach.FileName & Chr(13) & Chr(10)
Next pict
 
On Error Resume Next
    RszNew.Fields("PlikObraz") = File
    RszNew.Fields("Uwagimoje") = WFile
RszNew.Update
 
RszNew.Bookmark = RszNew.LastModified
 
RszNew.Edit
RszNew("id") = RszNew("Identyfikator")
RszNew.Update
 
myItem.Subject = myItem.Subject & " - [[" & RszNew("Identyfikator") & "]]"
myItem.Save
 
NewZal.Close
Set NewZal = Nothing
 
Set NewZal = OpenDatabase(BazaPlik).OpenRecordset("select * from Zalaczniki where IdSprawy = 919191919")
NewZal.MoveFirst
Do Until NewZal.EOF
    NewZal.Edit
    NewZal.Fields("IdSprawy") = RszNew("Identyfikator")
    NewZal.Update
    NewZal.MoveNext
Loop
 
RszNew.Close
Set RszNew = Nothing
 
NewZal.Close
Set NewZal = Nothing
 
On Error GoTo 0
 
If ile > 0 Then
MsgBox "Właśnie zapisałeś do bazy i eksportowałeś " & ile & " BazaPlik " & vbCr & Chr(34) & _
    "do katalogu SkanDoc\" & Chr(34) & " z wiadomości:" & vbCr & Chr(34) & _
    myItem.Subject & vbCr & Chr(34) & "BazaPlik:" & Dateczka & oAttach.FileName, vbInformation, "MS"
Else
MsgBox "zapisno do bazy"
End If
Set RszNew = Nothing
Set myItem = Nothing
Set oAttach = Nothing
 
End Sub
amis
 
Posty: 8
Dołączył(a): Cz 12.03.2015 20:30

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez OShon » N 25.10.2020 17:43

No to tak.
Jedyne miejsce w którym używasz treści i którą pytałeś to ta linijka
Kod: Zaznacz cały
    RszNew.Fields("uwagi") = "<- Od: " & myItem.SenderName & "," & myItem.SenderEmailAddress & ", " & myItem.ReceivedTime & " do: " & myItem.To & " ->" & Chr(10) & Chr(13) & Chr(10) & Chr(13) & myItem.Body


Zatem, jeśli masz w treści podwójne entery to albo mówimy o tych wynalazkach które zastosowałeś jak nagrywająca małpa makra (to nie o tobie, ale o mechanizmie MS): & Chr(10) & Chr(13) & Chr(10) & Chr(13)
albo faktycznie mówimy o części w której zapisujesz samą treść, czyli: myItem.Body

Jeśli to pierwsze - wywal to pozostawiając tylko jedną karetkę i jeden koniec linii - albo zamień to na vbcr() lub vbNewLine()
A jeśli to drugie, to wykonaj replace(myItem.Body,, "co zamieniamy","na co zamieniamy") tak aby został tylko jeden enter i po kłopocie.
Obrazek
Oskar Shon - MVP Office Dev. 11/21, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 10835
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez amis » N 25.10.2020 19:14

mój problem dotyczy wyłącznie
A jeśli to drugie, to wykonaj replace(myItem.Body,, "co zamieniamy","na co zamieniamy").

przetestuję i dam info.
dzięki
amis
 
Posty: 8
Dołączył(a): Cz 12.03.2015 20:30

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez amis » N 25.10.2020 22:50

Dzięki,
Pomogło. O to chodziło.
Pozdr.,
:)
amis
 
Posty: 8
Dołączył(a): Cz 12.03.2015 20:30

Re: Archiwizacja maili w excel (lub access) + załączniki

Postprzez OShon » N 25.10.2020 23:49

Super.
Polecam się i gratuluje.
Obrazek
Oskar Shon - MVP Office Dev. 11/21, 3x MCC, 4/9/22 TechNet
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 10835
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Projekt autorski VBATools.pl


Powrót do Microsoft Outlook

Kto przegląda forum

Użytkownicy przeglądający ten dział: Google [Bot] i 8 gości