Jorgen
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 " DownloadAttachmentFirstUnr eadEmail " and the called procedure " OpenExcelFile ".
Can you help
regards
Jørgen
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 " DownloadAttachmentFirstUnr
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
-bning-af-outlook-mail-og-gem-attachment
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
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
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
If, instead, "account" means another mailbox defined in your default mail profile, then this should do it.
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)
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
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
OK
I will try the second version, when I am back on that computer tomorrow.
best regards
Jørgen
I will try the second version, when I am back on that computer tomorrow.
best regards
Jørgen
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?