Opgelost Meerdere mails opslaan als Tekstbestand

[Georgyboy]

Goeiedag,

Vraagjes,

1) In Outlook kunnen we een mail opslaan in een map op bv. de C:/ Schijf als tekstbestand (Alleen-tekst(*.txt)
Dit gaat goed als we dit per 1 mail doen.
Maar kunnen we dit van meerdere geselecteerde mails doen?

2) De geselcteerde mails bevatten soms bijlagen, kunnen we de bijlagen uit de mails ook opslaan naar 1 map op de C:/Schijf?
Per mail gaat dit makkelijk, zou dit kunnen van meerdere mails?

Doel is om bepaalde gegevens van klanten en/of leveranciers in een andere map bij te houden.

Indien dit mogelijk is hoe zou dit kunnen? Is er in outlook een VBA code nodig? of kan het anders?

Alvast bedankt,
Groeten Georgyboy

 

[OctaFish]

Je kunt een macro maken die alle mails en bijlagen uit een map opslaat. Niet de makkelijkste macro, omdat Outlook geen IntelliSense heeft, maar het is wel te doen. Ik heb zelf zo'n macro ook wel eens gemaakt.

 

[Georgyboy]

Dank voor je info, altijd leerzaam

Het gaat soms om een aantal mails om dze apart op te slaan als tekstbestand alsook de bijlagen naar een andere map te verplaatsen (buiten een map in outlook.

Soms wil men leren hoe het kan, maar vermoed dat het niet zo simpel is om dit te doen van een beperkt aantal mails.

Ps een macro zal me nog niet lukken

Dit is een voiorstel van ChatGpt, maar heb geleerd om dit met een grote korrel zout te nemen, toch voor de specialisten

Sub SaveEmailsAsText()
Dim objOL As Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objSelection As Outlook.Selection
Dim objItem As Object
Dim objMail As Outlook.MailItem
Dim strPath As String
Dim strFileName As String

Set objOL = Outlook.Application
Set objNamespace = objOL.GetNamespace("MAPI")
Set objSelection = objOL.ActiveExplorer.Selection

' Kies de map waar je de e-mails wilt opslaan
strPath = "C:\Path\To\Your\Folder\"

' Loop door de geselecteerde e-mails
For Each objItem In objSelection
If TypeOf objItem Is Outlook.MailItem Then
Set objMail = objItem
strFileName = strPath & objMail.Subject & ".txt"
' Opslaan als tekstbestand
objMail.SaveAs strFileName, olTXT
End If
Next

MsgBox "E-mails succesvol opgeslagen als tekstbestanden!"

' Opruimen
Set objMail = Nothing
Set objItem = Nothing
Set objSelection = Nothing
Set objNamespace = Nothing
Set objOL = Nothing
End Sub

 

[OctaFish]

En dit is een variant die ik gebruik om bijlagen op te slaan. Die kun je vast combineren/aanpassen .

Sub BijlagenOpslaanPrinten()

' Deze macro controleert een voorgedefinieerde subfolder in Outlook op Attachments
' en slaat die met PDF-extensie op in een voorgedefinieerde map.
' De opgeslagen bestanden kunnen bekeken worden in Internet Explorer.
' De opgeslagen bestanden worden afgedrukt op de standaardprinter.

' Afvangen van fouten
On Error GoTo SaveAttachmentsToFolder_err
' Variabelen declareren

    Pad = "H:\Bijlagen\"
    Set NS = GetNamespace("MAPI")
    ' Gebruik onderstaande routine om een folder te selecteren...
    Set Folder = NS.PickFolder
    ''Set Folder = Application.GetNamespace("MAPI").PickFolder
    ' Of typ een naam voor het selecteren van een vaste folder...
    Set Folder = NS.GetDefaultFolder(olFolderInbox)     ' Met Early Binding
    Set Folder = NS.GetDefaultFolder(9)                 ' Met Late Binding
    ''Set Folder = Inbox.Folders("Helpdesk") 'TYP HIER DE NAAM VAN DE Folder IN OUTLOOK.

    i = 0
    '==========================================================================================================================
    'Hieronder de code zoals hij hoort te gaan.....
    '==========================================================================================================================
    ' Controleer de Folder op Attachments en sluit af als er niets gevonden wordt.
    If Folder.Items.Count = 0 Then
        MsgBox "Er zijn geen berichten met Bijlagen in de folder " & Folder.Name & ".", vbInformation, "Niets gevonden"
        Exit Sub
    End If
   
    ' Controleer elk bericht op Attachments
    For Each Item In Folder.Items
        For Each atmt In Item.Attachments
            ' Controleer de filenaam van elke Attachment and sla die met "pdf" extensie op in voorgedefineerde map.
            If Right(atmt.FileName, 3) = "pdf" Or Right(atmt.FileName, 3) = "img" Then
                FileName = Pad & atmt.FileName
                atmt.SaveAsFile FileName
                i = i + 1
                'document printen
                'Shell """C:\Program Files\Adobe\Reader 9.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
            End If
        Next atmt
    Next Item
   
    ' Laat een totaal van berichten zien
    If i > 0 Then
        varResponse = MsgBox("Er zijn " & i & " bijlagen." & vbCrLf _
            & "Ze zijn opgeslagen in " & Pad & "." & vbCrLf & vbCrLf _
            & "Wil je ze nu bekijken?", vbQuestion + vbYesNo, "Klaar!")
       
        ' Open Windows Explorer om de opgeslagen bestanden te laten zien.
        If varResponse = vbYes Then
            Shell "Explorer.exe /e," & Pad, vbNormalFocus
        End If
    Else
        MsgBox "Ik heb geen bijlagen gevonden in de mail(s).", vbInformation, "Finished!"
    End If
   
    'Tel het aantal mailtjes in de folder
    iCount = Folder.Items.Count
    varResponse = MsgBox("Wil je de " & iCount & " mailtjes nu wissen?", vbQuestion + vbYesNo, "Finished!")
    ' Alle mailtjes wissen.
    If varResponse = vbYes Then
        For i = Folder.Items.Count To 1 Step -1
            Folder.Items.Item(i).Delete
            numDeleted = iCount - Folder.Items.Count
            If numDeleted Mod 100 = 0 Then
                MsgBox ("Deleted " & numDeleted & " items of " & iCount & ".")
            End If
        Next
        MsgBox ("Successfully deleted " & numDeleted & " items.")
    End If
   
    ' Maak het geheugen leeg
SaveAttachmentsToFolder_exit:
    Set atmt = Nothing
    Set Item = Nothing
    Set NS = Nothing
    Exit Sub
   
    ' Foutverwerking
SaveAttachmentsToFolder_err:
    MsgBox "Er is een fout opgetreden." _
    & vbCrLf & "Rapporteer de volgende fout." _
    & vbCrLf & "Macro Naam: BijlagenOpslaanPrinten()" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume SaveAttachmentsToFolder_exit

End Sub

 

[Georgyboy]

Dankjewel OctaFish !