OUT 2010 Automatyczny zapis tytułu wiadomości do pliku txt

Pytania, uwagi, problemy związane z Microsoft Office Outlook, wersje 2007, 2010, 2013 i 2016.

Moderator: Moderatorzy

OUT 2010 Automatyczny zapis tytułu wiadomości do pliku txt

Postprzez drFeelGood » N 11.03.2018 17:14

Witam, znalazłem w sieci poniższy kod zapisujący całą wiadomość do pliku textowego.
Potrzebuję zmodyfikować kod tak aby w połączeniu z regułą po otrzymaniu maila jego tytuł (tylko tytuł) został zapisany w pliku txt.
VBA to dla mnie nowy temat, proszę o pomoc.

Kod: Zaznacz cały
Sub SaveMyMsg(MyMail As MailItem)
'MVP OShon from VBATools.pl
 Dim fso As Object 'FileSystemObject
 Dim strID$, strFolderPath$, strSaveName$
 Dim olNS As Outlook.NameSpace
 Dim oMail As Outlook.MailItem

 strID = MyMail.EntryID
 Set olNS = Application.GetNamespace("MAPI")
 Set oMail = olNS.GetItemFromID(strID)
 strFolderPath = MakeWholePath("C:\Temp\")
 strSaveName = "Wiadomosc.txt"
 Set fso = CreateObject("Scripting.FileSystemObject")

 If fso.FileExists(strFolderPath & strSaveName) Then
    fso.DeleteFile strFolderPath & strSaveName
 End If

 oMail.SaveAs strFolderPath & strSaveName, olTXT

 Set oMail = Nothing
 Set olNS = Nothing
 Set fso = Nothing
End Sub

Private Function FileExists(FilePath As String) As Boolean
On Error GoTo blad
 FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
Exit Function
blad:
FileExists = False
End Function

Private Sub MakeWholePath(FileWithPath As String)
Dim x&, PathToMake$
For x = LBound(Split(FileWithPath, "\")) To UBound(Split(FileWithPath, "\")) - 1
 PathToMake = PathToMake & "\" & Split(FileWithPath, "\")(x)
 If Right$(PathToMake, 1) <> ":" Then
 If FileExists(Mid(PathToMake, 2, Len(PathToMake))) = False Then _
 MkDir Mid(PathToMake, 2, Len(PathToMake))
 End If
Next
End Sub
drFeelGood
 
Posty: 3
Dołączył(a): N 11.03.2018 17:09

Re: OUT 2010 Automatyczny zapis tytułu wiadomości do pliku t

Postprzez OShon » Pn 12.03.2018 14:16

Nie ten kod. Przywołany przez ciebie zapisuje każdy z maili w osobnym pliku TXT.
Zobacz jak się tworzy plik dzięki metody "Open File for" Opisanej w helpie lub przez kontrolkę FSO.
Zobacz jakie parametry ma kontrolka Mailitem, i który z nich odpowiada za temat.
Spróbuj sam napisać kod, a jeśli będziesz miał z czymś konkretnym problem to ci pomogę. Na razie zgłęb pow tematy.
Obrazek
Oskar Shon - MVP Office System/Development 11/18, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9448
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Veracomp SA, VBATools.pl

Re: OUT 2010 Automatyczny zapis tytułu wiadomości do pliku t

Postprzez drFeelGood » Pn 12.03.2018 18:39

Poszperałem, znalazłem inny kod, zapisujący przychodzącego maila do pliky txt, zmodyfikowałem go tak żeby zapisywał do pliku tytuł, ale coś jest nie tak.
Czy kod poniżej nie powinien otworzyć pliku i zapisać do niego tytułu a następnie go zamknąć?
Kod: Zaznacz cały
Open "C:\Temp\Remote.txt" For Output As #1
   Print #1, sName
Close #1


Cały kod
Kod: Zaznacz cały
Public WithEvents Items As Outlook.Items

Public Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub

Public Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
    SaveMailAsFile Item
  End If
End Sub

Public Sub SaveMailAsFile(oMail As Outlook.MailItem)
  Dim dtDate As Date
  Dim sName As String
  Dim sFile As String
  Dim sExt As String

  sPath = "C:\Temp\"
  sExt = ".txt"
  sName = oMail.Subject
  ReplaceCharsForFileName sName, "_"
  dtDate = oMail.ReceivedTime
 
 
 Open "C:\Temp\Remote.txt" For Output As #1
 
  Print #1, sName
Close #1
 
End Sub

Public Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub
drFeelGood
 
Posty: 3
Dołączył(a): N 11.03.2018 17:09

Re: OUT 2010 Automatyczny zapis tytułu wiadomości do pliku t

Postprzez OShon » Pn 12.03.2018 19:44

Nie wiem po co się pchasz w zdarzenia.
Procedura z parametrem jest czytelna i możliwa do podłączenia np regułą.
Ale jak chcesz skomplikować sobie życie to też można.

To całe to, to po co?
Kod: Zaznacz cały
  Dim dtDate As Date
  Dim sName As String
  Dim sFile As String
  Dim sExt As String

  sPath = "C:\Temp\"
  sExt = ".txt"
  ReplaceCharsForFileName sName, "_"
  dtDate = oMail.ReceivedTime


Do tego źle doczytałeś, jakie są parametry zapisu pliku. Output tworzy plik kasując poprzedni, Append dopisuje.
Zwróć uwagę na coś takiego:
Kod: Zaznacz cały
Sub zapisz_temat(mail As MailItem)
Open "C:\Temp\Remote.txt" For Append As #1
   Print #1, mail.Subject
Close #1
End Sub
Obrazek
Oskar Shon - MVP Office System/Development 11/18, 3x MCC
Forum moderator: Outlook.pl | ExcelForum.pl | MSDN dział VBA
Zobacz fajne dodatki: Outlooka, Excela, Worda lub PowerPointa
OShon
 
Posty: 9448
Dołączył(a): Cz 19.10.2006 08:31
Lokalizacja: Veracomp SA, VBATools.pl

Re: OUT 2010 Automatyczny zapis tytułu wiadomości do pliku t

Postprzez drFeelGood » So 31.03.2018 22:28

Byłem blisko :-) Output zamierzony. Dziękuję za pomoc, spokojnych Świąt dla użytkowników Forum .
drFeelGood
 
Posty: 3
Dołączył(a): N 11.03.2018 17:09


Powrót do Microsoft Outlook 2007 / 2010 / 2013 / 2016

Kto przegląda forum

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