Link to home
Start Free TrialLog in
Avatar of Jorgen
JorgenFlag for Denmark

asked on

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

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
Avatar of James Elliott
James Elliott
Flag of United Kingdom of Great Britain and Northern Ireland image

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?
Avatar of Jorgen

ASKER

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
Avatar of David Lee
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

Avatar of Jorgen

ASKER

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
ASKER CERTIFIED SOLUTION
Avatar of David Lee
David Lee
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Jorgen

ASKER

OK

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

best regards

Jørgen