Solved

Excel VBA code to open a different account than my standard mail account (outlook)

Posted on 2015-01-29
6
399 Views
Last Modified: 2016-02-10
Hi Experts,

I have a couple of procedures, that take the last unread mail and saves the attachement in the specified directory (and afterwards opens the file). This Works very well.

But now our finance department asks if I can change the Outlook account to a specific mail account. And here I need help. I have seen other ways to solve our existing procedure, and they look more like working with the Outlook application directly. But since the existing procedure Works fine for our finance people, I do not want to change that, if I do not have to.

In the code snippet, I have included a couple of extra procedures, that we Work to include as well, but they are of minor interest for this question, unless you think differently.

The procedure, that I need to change is " DownloadAttachmentFirstUnreadEmail " and the called procedure " OpenExcelFile ".

Can you help

regards

Jørgen
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\Users\xjoewr\Documents\"
'~~> Path + Filename of the email for saving
Const sEmail As String = "C:\ExportedEmail.msg"

Dim strTest

Sub ExtractFirstUnreadEmailDetails()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object

    
    '~~> Outlook Variables for email
    Dim eSender As String, dtRecvd As String, dtSent As String
    Dim sSubj As String, sMsg As String

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Store the relevant info in the variables
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        eSender = oOlItm.SenderEmailAddress
        dtRecvd = oOlItm.ReceivedTime
        dtSent = oOlItm.CreationTime
        sSubj = oOlItm.Subject
        sMsg = oOlItm.Body
        Exit For
    Next

    Debug.Print eSender
    Debug.Print dtRecvd
    Debug.Print dtSent
    Debug.Print sSubj
    Debug.Print sMsg
End Sub

Sub DownloadAttachmentFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object
  

    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                '~~> Download the attachment
                
                oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                strTest = NewFileName & oOlAtch.Filename
                               
                Exit For
            Next
        Else
            MsgBox "The First item doesn't have an attachment"
        End If
        Exit For
    Next
    
    Call OpenExcelFile

 End Sub
 
Sub SaveFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Save the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.SaveAs sEmail, 3
        Exit For
    Next
End Sub

Sub MarkAsUnread()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Mark 1st unread email as read
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.UnRead = False
        DoEvents
        oOlItm.Save
        Exit For
    Next
 End Sub
 Sub OpenExcelFile()
    Dim wb As Workbook

    '~~> FilePath is the file that we earlier downloaded
    Workbooks.Open (strTest)

    'Set wb = Workbooks.Open(filepath)
End Sub

Open in new window

-bning-af-outlook-mail-og-gem-attachment
0
Comment
Question by:Jorgen
  • 3
  • 2
6 Comments
 
LVL 12

Expert Comment

by:James Elliott
ID: 40579455
The code has been written to open your Outlook which is already configured to access your email account, and your emails.

Changing the premise of this and pointing the code towards your Outlook which is not currently configured to pull emails from a different email account, will require more-than-a-few code changes & additions.

Is the other email account an account to which you already have permissions to read emails / download attachments?

How do you normally access this email box?
0
 
LVL 4

Author Comment

by:Jorgen
ID: 40581296
Hi James,

it is a new mail account, that our company will create, to get a structured way for customers to send their orders.
So all, that will be running the macro on their computers will have access to this mail account

But it will not be their primary mail account.

I hope that answered your question.

regards

Jørgen
0
 
LVL 76

Expert Comment

by:David Lee
ID: 40583952
Hi, Jørgen.

I'm not sure what "account" means in the context of your question.  If it means "profile", then here's how to open a different profile

Set oOlAp = CreateObject( "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
'On the next line, change "SomeProfileName" to the name of the profile you want to open
oOlns.Logon "SomeProfileName"
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

Open in new window


If, instead, "account" means another mailbox defined in your default mail profile, then this should do it.

Set olkApp = GetObject(, "Outlook.application")
Set olkSes = oOlAp.GetNamespace("MAPI")
'On the next line, change "PathToTheFolder" to an Outlook folder path that points to the target folder
Set oOlInb = OpenOutlookFolder("PathToTheFolder")

Function OpenOutlookFolder(strFolderPath)
    Dim arrFolders, varFolder, bolBeyondRoot
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = olkSes.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Open in new window

0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 4

Author Comment

by:Jorgen
ID: 40590745
Hi BlueDevilFan

Sorry for the late reply!

My normal account could be xxx@companyname.com
once a day I need to extract data from the inbox of a mailaddress invoice@companyname.com

If I understand your response correctly, I need to choose the first example?

regards

Jørgen
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 40590776
Hi, Jørgen.

"Sorry for the late reply!"
No worries.

"If I understand your response correctly, I need to choose the first example?"
Probably not.  You probably want the second example.  An email address is not a profile.  In Outlook parlance, a profile is a collection of settings and mailboxes.  A given profile can define one or more mailboxes (email addresses) and associated settings.  While it's certainly possible that you have a separate profile for the address "invoice@companyname.com", it's unlikely.  Here's how to tell.  Do you have to exit out of Outlook, then log back in and select a different profile from a "Choose Profile" dialog-box to get to that mailbox?  Then, when you're finished working with that mailbox, do you have to again exit Outlook, then launch it and log back in again this time selecting a different profile from the "Choose Profile" dialog-box to get back to your personal mailbox?  If the answer to those last two questions is "yes", then you do want the code in the first example.  Otherwise, you want the code in the second example.
0
 
LVL 4

Author Comment

by:Jorgen
ID: 40591663
OK

I will try the second version, when I am back on that computer tomorrow.

best regards

Jørgen
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
This process describes the steps required to Import and Export data from and to .pst files using Exchange 2010. We can use these steps to export data from a user to a .pst file, import data back to the same or a different user, or even import data t…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now