save last sent email from outlook after click a button in access

[lucass3231]

I am curious if it is possible to start macro from access that save last sent email from outlook to local folder? I have something like that at this moment but it saves all emails when sending. Please advise. now I past it into vb in access but got an error 'Method or data member not found' and highlighted first line:

Code:
PrivateSub Command82_Click()
Code:

Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.Folder
Dim myNewFolder As Outlook.Folder
Dim myItem As Outlook.MailItem
Dim myCopiedItem As Outlook.MailItem
Dim myItems AsObject
Dim savePath AsString

Set myNameSpace = Application.GetNamespace("MAPI")

Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)

Set myItems = myFolder.Items
myItems.Sort ("[SentOn]")


Set myItem = myItems.GetLast

savePath ="C:\Users\ll59205\Desktop\New folder\archiwum"'## Modify as needed
savePath = savePath & m.Subject & Format(Now(),"yyyy-mm-dd-hhNNss")
savePath = savePath &".msg"

Debug.Print myItem.CreationTime
myItem.SaveAs savePath, OlSaveAsType.olMsg
EndSub

[gmayor]

Your error occurs because Outlook commands are not part of the Access VBA command set. You need to make some changes to make those commands available.
If you are using the subject in the message filename, you are going to have to address illegal filename characters. The following also creates the folder, if not present, and addresses the remote possibility of duplicated filenames, so the message time becomes less necessary.

Option Explicit

Private Sub Command82_Click()
Dim olApp As Object
Dim olNS As Object
Dim olFolder As Object
Dim olItem As Object
Dim olItems As Object
Dim strPath As String

    strPath = Environ("USERPROFILE") & "\Desktop\New folder\archiwum\"
    CreateFolders strPath
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo err_Handler

    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(5)
    Set olItems = olFolder.Items
    
    olItems.Sort "[SentOn]", True
    Set olItem = olItems(1)
    SaveItem olItem, strPath
Debug.Print olItem.CreationTime
lbl_Exit:
    Set olApp = Nothing
    Set olNS = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing
    Set olItems = Nothing
    Exit Sub
err_Handler:
Debug.Print Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub


Private Sub SaveItem(olItem As Object, fPath As String)
'An Outlook macro by Graham Mayor - www.gmayor.com
Dim fname As String
    fname = Format(olItem.SentOn, "yyyy-mm-dd") & _
            Format(olItem.SentOn, "-HHMM") & Chr(32) & " - " & olItem.Subject
    fname = Replace(fname, Chr(58) & Chr(41), "")
    fname = Replace(fname, Chr(58) & Chr(40), "")
    fname = Replace(fname, Chr(34), "-")
    fname = Replace(fname, Chr(42), "-")
    fname = Replace(fname, Chr(47), "-")
    fname = Replace(fname, Chr(58), "-")
    fname = Replace(fname, Chr(60), "-")
    fname = Replace(fname, Chr(62), "-")
    fname = Replace(fname, Chr(63), "-")
    fname = Replace(fname, Chr(124), "-")
    SaveUnique olItem, fPath, fname
lbl_Exit:
    Exit Sub
End Sub

Private Function CreateFolders(strPath As String)
'An Office macro by Graham Mayor - www.gmayor.com
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    vPath = Split(strPath, "\")
    strPath = vPath(0) & "\"
    For lngPath = 1 To UBound(vPath)
        strPath = strPath & vPath(lngPath) & "\"
        If Not oFSO.FolderExists(strPath) Then MkDir strPath
    Next lngPath
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function

Private Function SaveUnique(oItem As Object, _
                            strPath As String, _
                            strFileName As String)
'An Outlook macro by Graham Mayor - www.gmayor.com
Dim lngF As Long
Dim lngName As Long
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    lngF = 1
    lngName = Len(strFileName)
    Do While fso.FileExists(strPath & strFileName & ".msg") = True
        strFileName = Left(strFileName, lngName) & "(" & lngF & ")"
        lngF = lngF + 1
    Loop
    oItem.SaveAs strPath & strFileName & ".msg"
lbl_Exit:
    Exit Function
End Function

[lucass3231]

Thank you gmayor! It works perfect