VBATools

Wiele czynności związanych z wysyłką emailingu marketingowego jest związane z późniejszymi raportami z działalności. Jak połączyć dane w folderach Outlooka z Excelem?

Można użyć darmowego programu CodeTwo Outlook Export i zapisać adresy do pliku, który następnie otworzyć plik Excelem, jednakże czasem nie można nic instalować i jedynym rozwiązaniem jest makro.

Uruchomić go można w developerze VBA (Alt+F11) w sekcji module.

Po artykule dotyczącym export wiadomości do excela, wiemy już jak użyć późnego wiązania – teraz go zastosujemy.

Jeśli nie ma się doświadczenia polecam przeczytać artykuł Instalacja i uruchamianie makr.

Option Explicit
Sub Zapis_maili_przychodzacych_Excel(oMail As MailItem)
'MVP OShon from VBATools.pl
If oMail.Class <> 43 Then Exit Sub 'olMail
Dim XLApp As Object 'Excel.Application
Dim wkb As Object, wks As Object, max_row&
Const sciezka$ = "c:\temp\OLvXL_adresy.xlsx"
Set XLApp = CreateObject("Excel.Application")
 XLApp.Visible = False
 If FileExists(sciezka) = False Then
   XLApp.Workbooks.Add
   XLApp.ActiveWorkbook.SaveAs sciezka
 Else
   XLApp.Workbooks.Open sciezka
 End If

 Set wkb = XLApp.ActiveWorkbook
 Set wks = wkb.Sheets(1)
 With wks
  .Activate
  max_row = .Cells(.Rows.Count, "a").End(xlUp).Row
  If max_row = 1 Then
   .Cells(1, 1).value = "SenderEmailAddress"
   .Cells(1, 2).value = "SenderName"
  End If
  .Cells(max_row + 1, 1).value = oMail.SenderEmailAddress
  .Cells(max_row + 1, 2).value = oMail.SenderName
 End With
 wkb.Close True
 XLApp.Quit
 Set wkb = Nothing
 Set wks = Nothing
 Set XLApp = 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

)

Jak podpinamy jako reguła? Po osadzeniu kodu w module VBA zaznaczamy pocztę przychodząca i akceptujemy komunikat o akceptacji wszystkich przychodzących wiadomości. Reszta wg poniższego ekranu:

(c) Shon Oskar – www.VBATools.pl