ms office outlook 2007 a spojeni vice emailu do jednoho
Napsal: 29 bře 2010 15:42
od kaktuzz
Ahoj,
nevite pls nekdo, jesli by slo treba 1000 e-mailu spojit do 1 e-mailu/textoveho souboru?
Kdyz dam tech 1000 emailu preposlat, tak se automaticky hazou do prilohy.
Mam tady nekolik tisic e-mailu s nedorucitelnymi zpravami na neplatne e-maily - a potreboval bych to spojit vsechno do 1 velkeho emailu/souboru.
Z toho 1 e-mailu/souboru uz dokazu vsechny ty neplatne e-maily vysosat a vyhodit je z databaze, aby se uz na ne nepreposilal newsletter.
diky za kazdou radu
kaktuzz
Re: ms office outlook 2007 a spojeni vice emailu do jednoho
Napsal: 06 dub 2010 10:05
od Poki
Zdravím,
vytvořil jsem tuhle proceduru do Outlooku, ale nejak se mi to pri testech sekalo na mailu c. 72 - muzes to vyzkouset, ale nezarucuju vysledek.
Skládá za sebe maily z aktuální složky a ukládá je do souboru.
Je nutné v referencích zaškrtnout Microsoft Scripting Runtime library.
Kód: Vybrat vše
Public objFSO As New FileSystemObject
Sub mailsTOfile()
Dim Slozka As String
Dim Pocet As Integer
Dim Cesta As String
Dim Nazev As String
Dim objNewFile As Object
Slozka = Application.ActiveExplorer.CurrentFolder.Name
zprava = MsgBox("Chceš vypsat všechny e-mail ze složky '" & Slozka & "'?" & vbCrLf & vbCrLf & "Budeš muset zadat cestu, kde se vytvoří cílový soubor.", vbYesNo, "Dotaz")
Select Case zprava
Case vbNo
Exit Sub
Case vbYes
Cesta = InputBox("Zadej cestu, kam uložím výsledný soubor", "Zadej cestu", "C:\Documents and Settings\UZIV_JMENO\Dokumenty\")
Nazev = InputBox("Zadej název souboru.", "Zadej název", "E-maily - " & Slozka)
Pocet = Len(Application.ActiveExplorer.CurrentFolder.Name)
Set objNewFile = objFSO.CreateTextFile(Cesta & Nazev & ".txt", True)
With objNewFile
.WriteLine ("Všechny e-maily ze složky '" & Application.ActiveExplorer.CurrentFolder.Name & "'")
.WriteLine ("===========================" & String(Pocet + 1, "="))
.WriteBlankLines 2
End With
For i = 1 To Application.ActiveExplorer.CurrentFolder.Items.Count
With objNewFile
.WriteLine ("-------------------------------------------------------------- " & i & ". e-mail")
.WriteLine ("Od: " & Application.ActiveExplorer.CurrentFolder.Items(i).SenderName)
.WriteLine ("Komu: " & Application.ActiveExplorer.CurrentFolder.Items(i).To)
.WriteLine ("Přijato: " & Application.ActiveExplorer.CurrentFolder.Items(i).ReceivedTime)
.WriteLine ("Velikost: " & Application.ActiveExplorer.CurrentFolder.Items(i).Size / 1000 & " kB")
.WriteLine ("Předmět: " & Application.ActiveExplorer.CurrentFolder.Items(i).Subject)
.WriteBlankLines 1
.WriteLine (Application.ActiveExplorer.CurrentFolder.Items(i).Body)
.WriteBlankLines 2
End With
Next
End Select
End Sub