Open outlook new email and attach most recent file from directory

lucass3231

New member
Local time
Today, 07:16
Joined
Jul 14, 2016
Messages
2
Dear all :)

I am trying to create a vba macro that allows me to open new message in outlook and attach most recent xlsx file from my folder path. All after click one button.

Here is what I have at this moment:


'Open new message
Sub OpenOutlook()
Dim Outlook As Object, Outmail As Object
Set Outlook = CreateObject("outlook.application")
Set Outmail = Outlook.createitem(0)
Outmail.display
End Sub

'Attach file
Option Explicit

Sub AttachXLSX()
Dim olMsg As MailItem
Dim strFilename As String
Const strPath As String = "C:\Users\ll59205\Desktop\New folder\komunikaty\"
On Error GoTo ErrHandler
If TypeName(ActiveWindow) = "Inspector" Then
If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
Set olMsg = ActiveInspector.CurrentItem
strFilename = LatestXLSXFile(strPath)
olMsg.Attachments.Add strPath & strFilename
End If
End If
lbl_Exit:
Set olMsg = Nothing
Exit Sub
ErrHandler:
Beep
Resume lbl_Exit
End Sub


Function LatestXLSXFile(strPath As String) As String
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
FileName = Dir(strPath & "*.xlsx", 0)
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(strPath & FileName)
Do While FileName <> ""
If FileDateTime(strPath & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(strPath & FileName)
End If
FileName = Dir
Loop
End If
LatestPDFFile = MostRecentFile
lbl_Exit:
Exit Function
End Function


But it doesn't work as I want.

any ideas how to do it? Thanks in advance!:)
 
Doesn't work is not very helpful - what isn't working - what error are you getting and where in the code is the error highlighted?
Please also put your code inside code tags and indent it to make it much easier to read;
Code:
'Open new message
Sub OpenOutlook()
    Dim Outlook As Object, Outmail As Object
    Set Outlook = CreateObject("outlook.application")
    Set Outmail = Outlook.createitem(0)
    Outmail.display
End Sub

'Attach file
Option Explicit

Sub AttachXLSX()
    Dim olMsg           As MailItem
    Dim strFilename     As String
    Const strPath       As String = "C:\Users\ll59205\Desktop\New folder\komunikaty\"
    On Error GoTo ErrHandler
    If TypeName(ActiveWindow) = "Inspector" Then
        If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
            Set olMsg = ActiveInspector.CurrentItem
            strFilename = LatestXLSXFile(strPath)
            olMsg.Attachments.Add strPath & strFilename
        End If
    End If
lbl_Exit:
    Set olMsg = Nothing
    Exit Sub
ErrHandler:
    Beep
    Resume lbl_Exit
End Sub


Function LatestXLSXFile(strPath As String) As String
    Dim FileName        As String
    Dim MostRecentFile  As String
    Dim MostRecentDate  As Date
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    FileName = Dir(strPath & "*.xlsx", 0)
    If FileName <> "" Then
        MostRecentFile = FileName
        MostRecentDate = FileDateTime(strPath & FileName)
        Do While FileName <> ""
            If FileDateTime(strPath & FileName) > MostRecentDate Then
                MostRecentFile = FileName
                MostRecentDate = FileDateTime(strPath & FileName)
            End If
            FileName = Dir
        Loop
    End If
    LatestPDFFile = MostRecentFile
lbl_Exit:
    Exit Function
End Function
 
I've got 'Compile error: User-defined type not defined'
and the line is highlighted 'Sub AttachXLSX()'
 

Users who are viewing this thread

Back
Top Bottom