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
ms office outlook 2007 a spojeni vice emailu do jednoho
Re: ms office outlook 2007 a spojeni vice emailu do jednoho
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.
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
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Nastavení zabezpečení internetu zabránilo v otevření jednoho nebo více souborů Příloha(y)
od magnator » 06 čer 2023 10:23 » v Windows 11, 10, 8... - 3
- 2058
-
od mmmartin
Zobrazit poslední příspěvek
06 čer 2023 21:22
-
-
- 1
- 1671
-
od mmmartin
Zobrazit poslední příspěvek
20 led 2024 19:21
-
-
Kontrola kopírování dat z jednoho disku na druhý Příloha(y)
od orfan » 25 dub 2024 11:59 » v Vše ostatní (sw) - 15
- 1038
-
od orfan
Zobrazit poslední příspěvek
25 dub 2024 19:51
-
-
-
MINI PC spojeni z internim HDD 3,5 ze stareho PC Příloha(y)
od Veroniqua » 20 srp 2023 08:53 » v Vše ostatní (hw) - 10
- 1621
-
od Veroniqua
Zobrazit poslední příspěvek
20 srp 2023 09:33
-
-
-
Vypínaní spojení mezi mobilem reprákem.
od nulka » 08 říj 2023 14:06 » v Mobily, tablety a jiná přenosná zařízení - 0
- 3687
-
od nulka
Zobrazit poslední příspěvek
08 říj 2023 14:06
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 4 hosti