I have searched for a solution to this, but no luck. I know it will be code based, but I'm really not sure where to start with it.
Here is the problem:
Input: 1 zip file containing multiple (upwards of 50) separate "Outlook Items"
Each outlook item opens up into an email that has an attachment on it.
Output: 1 file with all attachments from the Outlook items inside of it.
Example:
input:
Myzip.zip ->
Mail_item1.msg
Mail_item2.msg
Mail_item3.msg
output:
MyOutputFile ->
mail_item1_attachment.pdf
mail_item2_attachment.pdf
mail_item3_attachment.pdf
any guidance is appreciated. My only thoughts thus far are outlook VBA (can this access multiple .msg items in a folder on the C drive?)
Here is what I have so far:
Sub get_attachments_from_mailItems()
Dim inPath As String
Dim outPath As String
Dim msg As MailItem
Dim doc As Attachment
'What do I dim the following as?
Dim input_folder
Dim output_folder
Dim attachments 'collection? array?
inPath = "C:\temp\input"
outPath = "C:\temp\output"
'--I need most help with the folder objects and how to create them/use them --
'Open input folder as object
'open output folder as object
For Each msg In input_folder
'check message for attachments, then loop if there are
For Each doc In attachments
'Save attachment in output_folder
Next
Next
End Sub
Related
I'm using Visual Studio to build an addin to copy emails.
The condition is to check, according to SentOn/ReceivedTime, and copy only those emails from the source folder that do not exist in the destination folder.
I tried below code but its gives me an error System.OutOfMemoryException Out of memory or system resources.
Sub CopyMail(SourceFolder As Outlook.Folder, DestinationFolder As Outlook.Folder)
Dim sMail As Object
Dim dMail As Object
Dim MailC As Object
For Each sMail In SourceFolder.Items
For Each dMail In DestinationFolder.Items
If sMail.SentOn <> dMail.SentOn Then
MailC = sMail.Copy
MailC.Move(DestinationFolder)
End If
Next
Next
End Sub
There is a logic error in your nested loop - for each item in the destination folder you copy all non-matches from the source folder, even though those items may match other items in the destination folder.
Here's an approach (untested) which should work.
It's in VBA: my VB.NET is not good and anyway you tagged with VBA...
Sub CopyMail(SourceFolder As Outlook.Folder, DestinationFolder As Outlook.Folder)
Dim sMail As Object
Dim dMail As Object
Dim MailC As Object
Dim dictSent As New Scripting.dictionary, i As Long
'get a list of all unique sent times in the
' destination folder
For Each dMail In DestinationFolder.Items
dictSent(dMail.SentOn) = True
Next
'loop through the source folder and copy all items where
' the sent time is not in the list
For i = SourceFolder.Items.Count To 1 Step -1
Set sMail = SourceFolder.Items(i)
If Not dictSent.Exists(sMail.SentOn) Then
Set MailC = sMail.Copy 'copy and move
MailC.Move DestinationFolder
dictSent(sMail.SentOn) = True 'add to list
End If
Next i
End Sub
I'd like to list all of my emails in a specific folder by using Outlook MAPI. I have tried the following code,
but it only shows 400 out of the 20,000 emails in the folder. I would greatly appreciate it if anyone could please show me how to list all of the emails.
Sub EmailListinFolder()
Dim mn As Long
Dim Message As String
Dim item As Object
Dim NS As Object
Dim Folder As Object
'Get the MAPI Name Space
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
'Allow the user to select a folder in Outlook
Set Folder = NS.PickFolder
For Each item In Folder.Items
If item.Class = olMail Then
Message = item.Subject & "|" & item.CreationTime
If Len(Message) Then
mn = mn + 1
End If
End If
Next item
MsgBox (mn)
End Sub
Is that an online profile? Most likely you end up opening too many items (for each loop keeps all items referenced until the loop exits). Use Table object instead - see example at https://msdn.microsoft.com/VBA/Outlook-VBA/articles/folder-gettable-method-outlook.
Our firewall users send messages requesting unblocking certain websites that they believe shouldn't be blocked. Their messages subject fields contain such websites urls. In fact, one url is sent per message. Due to the increase in number of users, hundreds or may be thousands of messages are expected to be received per day.
Is there an Outlook macro that will collect or extract such urls (from received messages subject fields) into one single text file without having to open any message?
Deeply appreciating any assistance with this matter.
Thanks in advance
Please write this code to your Outlook VBA module. Change some names of folders and destination file in some lines below. For other information see comments inside sub.
Sub Retrieve_http()
'our Outlook folder- deifinitions
Dim myItem As MailItem
Dim myFolder As Folder
Dim myNamespace As NameSpace
Set myNamespace = Application.GetNamespace("MAPI")
'put your folders name here
'1st one is store folder which should refer to firewall_support#iuass.org
'second is possibly 'inbox folder'
Set myFolder = myNamespace.folders("firewall_support#iuass.org").folders("inbox")
'destination file
Dim resFile As String
resFile = "c:\Users\Kazik\Desktop\httpRequest.txt"
Dim ff As Byte
ff = FreeFile()
'creating or opening it- each time you run this macro we will append data
'until deletion of either file or its content
Open resFile For Append As #ff
For Each myItem In myFolder.items
If InStr(1, myItem.Subject, "http://") > 0 And _
InStr(1, myItem.Subject, "classified under:") > 0 Then
'write to file
Write #ff, myItem.Subject
End If
Next
Close #ff
End Sub
EDIT to include appropriate deletion process and reference of the code to the picture.
The following picture present Outlook window (Polish version) where: Business Mail is one of Top Folders (which refers to separate .pst file). 'Skrzynka odbiorcza' is just 'inbox'.
Code which searches for certain emails, retrieves subject of emails and deletes emails afterwards looks as follow:
Sub Retrieve_http()
'our Outlook folder- deifinitions
Dim myItem As MailItem
Dim myFolder As Folder
Dim myNamespace As NameSpace
Set myNamespace = Application.GetNamespace("MAPI")
'put your folders name here
Set myFolder = myNamespace.folders("Business Mail").folders("skrzynka odbiorcza")
'destination file
Dim resFile As String
resFile = "c:\Users\Kazik\Desktop\httpRequest.txt"
Dim ff As Byte
ff = FreeFile()
'creating or opening it- each time you run this macro we will append data
'until deletion of either file or its content
Open resFile For Append As #ff
Dim i!
For i = myFolder.items.Count To 1 Step -1
If InStr(1, myFolder.items(i).Subject, "http://") > 0 And _
InStr(1, myFolder.items(i).Subject, "classified under") > 0 Then
'write to file
Write #ff, myFolder.items(i).Subject
'delete item
myFolder.items(i).Delete
End If
Next
Close #ff
End Sub
here is the solution to your problem :)
When you make a For Each Outlook it enumerating each email.
If you move any email within the loop For Each, then Outlook changes the number of all the emails of the folder but doesn't change the iteration number of your loop. This results in several messages that will not be read.
Solution is to make a loop starting from the last email as mentioned here
Outlook macro to collect/extract data from "Subject field" of numerous messages into a text file
CODE:
Replace (For Each InboxMsg In Inbox.Items) with
For i = Inbox.Items.Count To 1 Step -1 'Iterates from the end backwards
Set InboxMsg = Inbox.Items(i)
I have a folder that contains a lot of pictures. I need to copy the pictures in that folder based on the input by the user and copy it into a new folder:
User enters input.
The code needs to search for the pictures in the folder based on the input.
If found, the pictures is than move to a new folder/another folder.
How do I do this?
This is an example of how to do it. I don't know what your "user input" is, so I just made an assumption. Rectify as appropriate.
Sub CopySomeFiles()
Dim FSO, sourceFolder, currentFile, filesInSourceFolder
Dim strSourceFolderPath As String
Dim strDestinationFolderPath As String
Dim strUserInput As String
Set FSO = CreateObject("Scripting.FileSystemObject")
' Figure out which file to copy from where to where
strUserInput = InputBox("Please enter name of file to copy.")
strSourceFolderPath = "C:\MySourceFolder"
strDestinationFolderPath = "C:\MyDestinationFolder"
Set sourceFolder = FSO.GetFolder(strSourceFolderPath)
Set filesInSourceFolder = sourceFolder.Files
' Look at all files in source folder. If name matches,
' copy to destination folder.
For Each currentFile In filesInSourceFolder
If currentFile.Name = strUserInput Then
currentFile.Copy (FSO.BuildPath(strDestinationFolderPath, _
currentFile.Name))
End If
Next
End Sub
I have a created folder in my outlook named "Reports". This folder contains emails with one attachment in each email. I would like to use ACCESS VBA to save the attachments from the "Reports" folder in Outlook to a local drive in my computer. here is the code I have so far, but gives me errors. Please help:
Sub GetAttachments()
Dim ns As NameSpace
Dim Inbox As Outlook.MAPIFolder
Dim folder As Outlook.MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.Folders.Item("Reports") // I get an error in this line says an object could not be found
i = 0
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
FileName = "C:\Automation\" & Atmt.FileName
Atmt.SaveAsFile FileName // here is another error says method is not found
i = i + 1
Next Atmt
Next Item
Is your Reports folder within your Inbox folder? You may need to do something like this:
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set RptFolder = Inbox.Folders("Reports")
Your syntax for saving attachments looks correct (apart from your comments not being correct for VBA). You could print out the Filename that you are creating to see if it's a valid name. And I assume that you have created the Automation folder that you mention.
Update:
Try declaring your Atmt as an Outlook.Attachment. There is such a thing as an Access.Attachment which does not have a SaveAsFile method, and it's probably picking that one up first. If you include the library name, you should get the one you need.
Update 2:
To get to your Reports folder, one way is to get the Inbox folder as you are currently doing, then get its parent, then get the Reports folder under that.
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set Mailbox = Inbox.Parent
Set RptFolder = Mailbox.Folders("Reports")
Another way would be to scan the items under "ns" to find the one that starts with "Mailbox", then get the Reports folder under that. It seems a little more cumbersome than getting the parent of the inbox. That also seems cumbersome, but I couldn't find a way to get to the Mailbox folder directly.
Replace
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
FileName = "C:\Automation\" & Atmt.FileName
Atmt.SaveAsFile FileName // here is another error says method is not found
i = i + 1
Next Atmt
With.....
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
FileName = "C:\Automation\" & Atmt.FileName
Attachments.SaveAsFile FileName // here is another error says method is not found
i = i + 1
Next Atmt
Outlook does not have a problem with atmt in the reference however, MS Access does. This should fix your problem.
Davis Rogers
Replace
Dim Atmt As Attachment
with
Dim Atmt As Outlook.Attachment
It'll make Access find the correct Class for atmt.