mailtje opslaan

[phobia]

Is het mogelijk om een verzonden mailtje als mailtje op te slaan op je pc?

ik mail met de volgende code:

Sub SendMail(TheName, TheAddress) 
Dim objMessage, Rcpt 

Rcpt = Chr(34) & TheName & Chr(34) & "<" & TheAddress & ">" 
Set objMessage = CreateObject("CDO.Message") 
objMessage.Subject = "This Month's Sales" 
objMessage.From = """Acme Sales"" <me@my.com>" 
objMessage.To = Rcpt 
objMessage.HTMLBody = TextBody 

objMessage.Send 

End Sub

heeft iemand een idee?

 

[Harry46]

Hier een stukje code waarin specifieke emails worden ingelezen.

Public Function fEmailOphalen() As String
    Dim Olapp                    As Object
    Dim Olmapi                   As Object
    Dim Olfolder                 As Object
    Dim OlMail                   As Object
    Dim OlItems                  As Object
    Dim strBody                  As String
    Dim intPos                   As Integer
    Dim strT                     As String
    Dim intAantalMails           As Integer
    Dim intAantalToegevoegd      As Integer
    Dim strMsg                   As String

    On Error Resume Next
    Set Olapp = CreateObject("Outlook.Application")
    Set Olmapi = Olapp.GetNamespace("MAPI")
    'Open de inbox
    Set Olfolder = Olmapi.GetDefaultFolder(6)  'olFolderInbox
    Set OlItems = Olfolder.Items

    For Each OlMail In OlItems
        If OlMail.UnRead = True Then
            If InStr(1, OlMail.Subject, "Nieuwe melding") > 0 Then    'nieuwe melding gevonden
                intAantalMails = intAantalMails + 1
                intPos = InStr(1, OlMail.body, "Nieuwe melding")
                strT = Mid$(OlMail.body, intPos + 15)
                intPos = InStr(1, strT, "|")
                If intPos > 0 Then
                    If fEmailNaarBestand(strT) Then
                        intAantalToegevoegd = intAantalToegevoegd + 1
                    End If
                End If
                OlMail.UnRead = False    'aanmerken als gelezen
            End If
        End If
    Next
 
    If blOutLookUIT Then
        Olapp.Quit
    End If
    Set Olapp = Nothing
    Set Olmapi = Nothing
    strMsg = "Aantal ongelezen emails met onderwerp 'nieuwe melding': " & CStr(intAantalMails)
    strMsg = strMsg & vbCrLf & vbCrLf & "Aantal ingelezen in databestand: " & CStr(intAantalToegevoegd)
    MsgBox strMsg, vbInformation, "Gelezen emails"
End Function

Code komt uit oude db, via kopieren en hier plakken, dus code aanpassen aan jouw situatie