Export danych wiadomości do Excela
by vbatools on Jun.29, 2010, under Excel, Outlook, Porady
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ć adresu 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.
Dodatkowo należy dodać bibliotekę Excela Menu/Tools/References i wybierasz Microsoft Excel (dostępna wersja) Object Liblary
Jeśli nie ma się doświadczenia polecam przeczytać artykuł Instalacja i uruchamianie makr.
Option Explicit
Sub Zapisz_do_Excela()
'MVP OShon from VBATools.pl
Dim oMail As Object, y&: y = 2
Dim xApp As New Excel.Application
Dim xWorkBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xWorkBook = xApp.Workbooks.Add
Set xlSheet = xApp.Sheets("Arkusz1")
On Error GoTo blad
With xlSheet
.Range("a1").value = "Adresat"
.Range("b1").value = "Czas utworzenia"
.Range("c1").value = "Temat"
For Each oMail In Application.ActiveExplorer.Selection
.Cells(y, 1).value = oMail.SenderEmailAddress '.SenderName 'drugi parametr podaje nazwę wyświetlaną
.Cells(y, 2).value = oMail.CreationTime
.Cells(y, 3).value = oMail.Subject
'itd....
y = y + 1
Next oMail
End With
koniec:
On Error Resume Next
With xWorkBook
'jeśli usunie się poniższą linijkę będzie pytać gdzie i z jaką nazwą zapisać plik
.SaveAs fileName:="C:\Temp\Outlook_dane_obiektów.xls", FileFormat:=xlNormal
.Close
End With
Set xlSheet = Nothing
Set xWorkBook = Nothing
Exit Sub
blad:
MsgBox "Błąd wykonania procedury ''Zapisz_do_Excela''" & vbCr _
& "Zaznacz wiadomości przy pomocy klawisza Ctrl i myszki i ponów operacje.", _
vbInformation, "Informacja o błędzie."
Resume koniec
End Sub
Aby w projekcie użyć późnego wiązania należy skonstruować kod w następujący sposób (w tedy nie jest konieczne dodawanie kontrolki w referencjach):
Dim xApp As Object 'New Excel.Application Dim xWorkBook As Object 'Excel.Workbook Dim xlSheet As Object 'Excel.Worksheet Set xApp = CreateObject("Excel.Application")
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.