Need to save the .xls file as .xlsx without opening it through VBA code in outlook

Need help -

How to save the .xls file as .xlsx without opening it:

Below code is working properly and saving files but need to change the extension while saving .



Sub SaveLatestAttachment()
Dim olApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim NS As Outlook.NameSpace
Dim oFolder As Outlook.Folder
Dim SaveInFolderName As String
Dim SaveInFolder As String
Dim subFolderName As String
Dim strFile As String
Dim Item As Object
Dim Items As Outlook.Items
Dim x()
Dim i As Long

SaveInFolderName = CreateObject("WScript.Shell").SpecialFolders(16)
subFolderName = "EmailAttachments"
SaveInFolder = SaveInFolderName & "\" & subFolderName & "\"

Set olApp = New Outlook.Application
Set NS = olApp.GetNamespace("MAPI")
Set oFolder = NS.GetDefaultFolder(olFolderInbox).Parent.Folders("Test")
ReDim x(1 To oFolder.Items.Count, 1 To 4)
Set Items = oFolder.Items
Items.Sort "[ReceivedTime]", True
For Each Item In Items
    If TypeOf Item Is Outlook.MailItem Then
        Set oMail = Item
        If LCase(oMail.Subject) = "my daily report" Then
            If oMail.Attachments.Count > 0 Then
                For i = 1 To oMail.Attachments.Count
                    strFile = oMail.Attachments(i).FileName
                    If InStr(LCase(strFile), "my report") > 0 Then
                        MsgBox oMail.ReceivedTime
                        strFile = SaveInFolder & strFile
                        On Error Resume Next
                        Kill strFile
                        On Error GoTo 0
                        oMail.Attachments(i).SaveAsFile strFile
                        GoTo ExitSub
                    End If
                Next i
            End If
        End If
    End If
Next Item
ExitSub:
Set olApp = Nothing
MsgBox "Task Completed Successfully.", vbInformation
End Sub

Open in new window

Afzal KhanSoftware ProfessionalAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David FavorLinux/LXD/WordPress/Hosting SavantCommented:
Or you can use a single command...

libreoffice --headless --convert-to output_file_extension[:output_filter_name] [--outdir output_dir] file

Open in new window


To convert to all manner of formats.

https://ask.libreoffice.org/en/question/2641/convert-to-command-line-parameter/ provides details.

Libreoffice runs under Java, or really JRE, so runs on all Operating Systems, including Windows.
0
Afzal KhanSoftware ProfessionalAuthor Commented:
Thanks Dave but its not working in VBA outlook
0
QlemoBatchelor, Developer and EE Topic AdvisorCommented:
Sorry, that won't work that easily, AFzal. You cannot just change the extension of a file and expect it to work flawlessly afterwards. There is a reason the new Excel format is named XLSX, because it is totally different from the XLS format used before. XLSX is in fact a ZIP file containing a lot of XML.

So you  have to  open and save the file in Excel or something capable of converting from XLS to XLSX. E.g. you could use your code to save as XLS, then call David's command with ShellExecute to convert to XLSX (if using LibreOffice is feasible for you). Or use Excel Automation instead, to control Excel via Outlook VBA.
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Try something like this...

Sub SaveLatestAttachment()
Dim olApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim NS As Outlook.NameSpace
Dim oFolder As Outlook.Folder
Dim SaveInFolderName As String
Dim SaveInFolder As String
Dim subFolderName As String
Dim strFile As String
Dim Item As Object
Dim Items As Outlook.Items
Dim x()
Dim i As Long
Dim xlApp As Object
Dim wb As Object
Dim strFileNew As String

SaveInFolderName = CreateObject("WScript.Shell").SpecialFolders(16)
subFolderName = "EmailAttachments"
SaveInFolder = SaveInFolderName & "\" & subFolderName & "\"

Set olApp = New Outlook.Application
Set NS = olApp.GetNamespace("MAPI")
Set oFolder = NS.GetDefaultFolder(olFolderInbox).Parent.Folders("Test")
ReDim x(1 To oFolder.Items.Count, 1 To 4)
Set Items = oFolder.Items
Items.Sort "[ReceivedTime]", True
For Each Item In Items
    If TypeOf Item Is Outlook.MailItem Then
        Set oMail = Item
        If LCase(oMail.Subject) = "my daily report" Then
            If oMail.Attachments.Count > 0 Then
                For i = 1 To oMail.Attachments.Count
                    strFile = oMail.Attachments(i).FileName
                    If InStr(LCase(strFile), "my report") > 0 Then
                        strFile = SaveInFolder & strFile
                        On Error Resume Next
                        Kill strFile
                        On Error GoTo 0
                        oMail.Attachments(i).SaveAsFile strFile
                        strFileNew = Replace(strFile, ".xls", ".xlsx")
                        Set xlApp = CreateObject("Excel.Application")
                        Set wb = xlApp.workbooks.Open(strFile)
                        xlApp.Application.DisplayAlerts = False
                        wb.SaveAs strFileNew, 51
                        wb.Close True
                        xlApp.Quit
                        Set xlApp = Nothing
                        Kill strFile
                        GoTo ExitSub
                    End If
                Next i
            End If
        End If
    End If
Next Item
ExitSub:
Set olApp = Nothing
MsgBox "Task Completed Successfully.", vbInformation
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Afzal KhanSoftware ProfessionalAuthor Commented:
Thanks Subodh , the code is working but one query how to run macros automatically when new email arrives in "Test" folder .
I am using below code in "ThisOutlookSession" but it is checking all incoming emails in outlook , just need to check "Test" folder only.

Private Sub Application_NewMail()
    Call SaveAttachments
End Sub 

Open in new window


Also "Run as Script" is not available.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Afzal!

I have no experience with Outlook event codes so I suggest you to close this question and open a New Question with your new requirement so that other experts can help you.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.