ms office outlook 2007 a spojeni vice emailu do jednoho

[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

[Reklama]

[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