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 :)