Save Mail in Sent folder outlook 2013

[PM312]

i have below code to send email in outlook 2013

   Try
            Dim SmtpServer As New SmtpClient()
            Dim mail As New MailMessage()
            SmtpServer.Credentials = New Net.NetworkCredential(OutlookID, OutlookPassword)
            SmtpServer.Port = ***
            SmtpServer.Host = "smtp.office365.com"
            SmtpServer.EnableSsl = True
            mail = New MailMessage()
            mail.From = New MailAddress(OutlookID)
            mail.To.Add(TbxTo.Text)
            mail.Subject = TbxSubject.Text
            mail.Body = TbxBody.Text
            SmtpServer.Send(mail)
            MsgBox("mail sent")
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try




    i want to save the sent mail in sent folder. But not getting correct code for saving item in sent folder.

    Thanks

[PM312]

https://social.msdn.microsoft.com/Forums/vstudio/en-US/97b21432-77e7-4693-aed6-2cc861703594/create-outlook-message-from-vbnet

[dxider]

Well, I have a piece of code to save items on any folder you have, it works on Outlook 2010, not tested it yet with 2013.

If you still need it, just reply to this message or send me an IM.

[PM312]

i would like to see the code.

[dxider]

This code lives inside an Outlook Macro, just a bit of work to make it work on Visual Studio.

NOTE: This code is not mine, I've found it on internet and I will copy as it was without modifications.

Option Explicit

'***********************************************************************
'* Code based on sample code from Martin Green and adapted to my needs *
'***********************************************************************

Sub GetAttachments()
On Error Resume Next
'create the folder if it doesnt exists:
    Dim fso, ttxtfile, txtfile, WheretosaveFolder
    Dim objFolders As Object
    Set objFolders = CreateObject("WScript.Shell").SpecialFolders

    'MsgBox objFolders("mydocuments")
    ttxtfile = objFolders("mydocuments")

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txtfile = fso.CreateFolder(ttxtfile & "\Email Attachments")
    Set fso = Nothing

    WheretosaveFolder = ttxtfile & "\Email Attachments"

On Error GoTo GetAttachments_err
' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    'Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    ' added the option to select whic folder to export
    Set Inbox = ns.PickFolder

    'to handle if the use cancalled folder selection
    If Inbox Is Nothing Then
                MsgBox "You need to select a folder in order to save the attachments", vbCritical, _
               "Export - Not Found"
        Exit Sub
    End If

    ''''


    i = 0
' Check Inbox for messages and exit of none found
    If Inbox.Items.Count = 0 Then
        MsgBox "There are no messages in the selected folder.", vbInformation, _
               "Export - Not Found"
        Exit Sub
    End If
' Check each message for attachments
    For Each Item In Inbox.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
           ' FileName = "C:\Email Attachments\" & Atmt.FileName
           'if want to add a filter:
           'If Right(Atmt.FileName, 3) = "xls" Then

           FileName = WheretosaveFolder & "\" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         Next Atmt
    Next Item
' Show summary message
    If i > 0 Then
        MsgBox "There were " & i & " attached files." _
        & vbCrLf & "These have been saved to the Email Attachments folder in My Documents." _
        & vbCrLf & vbCrLf & "Thank you for using Liron Segev - TheTechieGuy's utility", vbInformation, "Export Complete"
    Else
        MsgBox "There were no attachments found in any mails.", vbInformation, "Export - Not Found"
    End If
' Clear memory
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle errors
GetAttachments_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume GetAttachments_exit
End Sub

[PM312]

thanks