I'm trying to find a way to get mail attachments (programaticaly) , and then open it... can someone tell me how to do this or point me to a right direction?
This is a VBA script (use in a Macro in Outlook) which will loop over all attachments in all selected items in the current folder and Save them to disk.
It should get you started and I don't think it would take much to add some kind of process launch rather than save logic to it.
Public Sub SaveAttachments()
'Note, this assumes you are in the a folder with e-mail messages when you run it.
'It does not have to be the inbox, simply any folder with e-mail messages
Dim Exp As Outlook.Explorer
Dim Sel As Outlook.Selection
Dim AttachmentCnt As Integer
Dim AttTotal As Integer
Dim MsgTotal As Integer
Dim outputDir As String
Dim outputFile As String
Dim fileExists As Boolean
Dim cnt As Integer
'Requires reference to Microsoft Scripting Runtime (SCRRUN.DLL)
Dim fso As FileSystemObject
Set Exp = Application.ActiveExplorer
Set Sel = Exp.Selection
Set fso = New FileSystemObject
outputDir = "C:\Path"
If outputDir = "" Then
MsgBox "You must pick an directory to save your files to. Exiting SaveAttachments.", vbCritical, "SaveAttachments"
Exit Sub
End If
Dim att As Attachment
'Loop thru each selected item in the inbox
For cnt = 1 To Sel.Count
'If the e-mail has attachments...
If Sel.Item(cnt).Attachments.Count > 0 Then
MsgTotal = MsgTotal + 1
'For each attachment on the message...
For AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count
'Get the attachment
Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)
outputFile = att.FileName
outputFile = Format(Sel.Item(cnt).ReceivedTime, "yyyy-mm-dd_hhmmss - ") + outputFile
fileExists = fso.fileExists(outputDir + outputFile)
'Save it to disk if the file does not exist
If fileExists = False Then
att.SaveAsFile (outputDir + outputFile)
AttTotal = AttTotal + 1
End If
Set att = Nothing
Sel.Item(cnt).Close (Outlook.OlInspectorClose.olDiscard)
Next
End If
Next
'Clean up
Set Sel = Nothing
Set Exp = Nothing
Set fso = Nothing
'Let user know we are done
Dim doneMsg As String
doneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments in " + Format$(MsgTotal, "#,0") + " Messages."
MsgBox doneMsg, vbOKOnly, "Save Attachments"
Exit Sub
ErrorHandler:
Dim errMsg As String
errMsg = "An error has occurred. Error " + Err.Number + " " + Err.Description
Dim errResult As VbMsgBoxResult
errResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save Attachments")
Select Case errResult
Case vbAbort
Exit Sub
Case vbRetry
Resume
Case vbIgnore
Resume Next
End Select
End Sub
Look for the COM-reference of Outlook.
You can also use a macro written in vba to do this.
Related
I want to use built-in Open File dialog from my VSTO add-in. I have to set InitialFileName when showing the dialog. Unfortunately, this property does not exist in the Dialog class:
var Dlg = Word.Dialogs.Item(WdWordDialog.wdDialogFileOpen);
Dlg.InitialFileName = SomePath; //COMPILE ERROR: no such property
Try to cast it to FileDialog also doesn't work:
var Dlg = Word.Dialogs.Item(WdWordDialog.wdDialogFileOpen) as FileDialog;
Dlg.InitialFileName = SomePath; //RUNTIME EXCEPTION: null reference
What am I missing here?
Note: I'm using Add-in Express.
Got it. I had to cast my application object to Microsoft.Office.Interop.Word.Application to get access to the FileDialog member. The following code works:
var Dlg = ((Microsoft.Office.Interop.Word.Application)Word).get_FileDialog(MsoFileDialogType.msoFileDialogFilePicker);
Dlg.InitialFileName = STRfolderroot + STRfoldertemplatescommon + "\\" + TheModality + "\\" + TheModality + " " + TheStudyType + "\\";
Dlg.Show();
The Microsoft page in your post shows the property being used for the msoFileDialogFilePicker dialog but your code is using the wdDialogFileOpen. The example code on the MS page works fine but trying to use the property for wdDialogFileOpen also generates a run-time error.
So this works:
Sub ThisWorks()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
.InitialFileName = "C:\folder\printer_ink_test.docx"
'If the user presses the action button...
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
MsgBox "Selected item's path: " & vrtSelectedItem
Next vrtSelectedItem
'If the user presses Cancel...
Else
End If
End With
Set fd = Nothing
End Sub
But this fails:
Sub ThisFails()
Dim fd As Dialog
Set fd = Application.Dialogs(wdDialogFileOpen)
Dim vrtSelectedItem As Variant
With fd
' This line causes a run-time error
.InitialFileName = "C:\folder\printer_ink_test.docx"
'If the user presses the action button...
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
MsgBox "Selected item's path: " & vrtSelectedItem
Next vrtSelectedItem
'If the user presses Cancel...
Else
End If
End With
Set fd = Nothing
End Sub
Sorry for screenshot, I'm using my phone to answer.
This is how you do it for Excel according to the picture from google books: Globals.ThisWorkbook.ThisApplication.FileDialog
For MS Word according to this link, this is how its done:
Office.FileDialog dialog = app.get_FileDialog(
Office.MsoFileDialogType.msoFileDialogFilePicker);
//dialog.InitialFileName <-- set initial file name
dialog.Show();
I want to develop an add in Outlook to save the calendars in .ICS format.
I tried this code but it need a class that I should buy :/ !!
' Load the Outlook PST file
Dim pst As PersonalStorage = PersonalStorage.FromFile("d:\Data\Emails\PersonalStorage.pst")
' Get the Calendar folder
Dim folderInfo As FolderInfo = pst.RootFolder.GetSubFolder("Calendar")
' Loop through all the calendar items in this folder
Dim messageInfoCollection As MessageInfoCollection = folderInfo.GetContents()
For Each messageInfo As MessageInfo In messageInfoCollection
' Get the calendar information
Dim calendar As MapiCalendar = CType(pst.ExtractMessage(messageInfo).ToMapiMessageItem(), MapiCalendar)
' Display some contents on screen
Console.WriteLine("Name: " & calendar.Subject)
' Save to disk in ICS format
calendar.Save("Calendar\" & calendar.Subject & ".ics", AppointmentSaveFormat.Ics)
Next messageInfo
Calendars in Outlook are represented by the folders with Outlook items inside. The Folder class provides the GetCalendarExporter method which reates a CalendarSharing object for the specified Folder. Be aware, the GetCalendarExporter method can only be used on calendar folders. An error occurs if you use the method on Folderobjects that represent other folder types.
The CalendarSharing class provides the SaveAsICal method which exports calendar information from the parent Folder of the CalendarSharing object as an iCalendar calendar (.ics) file.
The following VBA example creates a CalendarSharing object for the Calendar folder, then exports the contents of the entire folder (including attachments and private items) to an iCalendar calendar (.ics) file.
Public Sub ExportEntireCalendar()
Dim oNamespace As NameSpace
Dim oFolder As Folder
Dim oCalendarSharing As CalendarSharing
On Error GoTo ErrRoutine
' Get a reference to the Calendar default folder
Set oNamespace = Application.GetNamespace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
' Get a CalendarSharing object for the Calendar default folder.
Set oCalendarSharing = oFolder.GetCalendarExporter
' Set the CalendarSharing object to export the contents of
' the entire Calendar folder, including attachments and
' private items, in full detail.
With oCalendarSharing
.CalendarDetail = olFullDetails
.IncludeWholeCalendar = True
.IncludeAttachments = True
.IncludePrivateDetails = True
.RestrictToWorkingHours = False
End With
' Export calendar to an iCalendar calendar (.ics) file.
oCalendarSharing.SaveAsICal "C:\SampleCalendar.ics"
EndRoutine:
On Error GoTo 0
Set oCalendarSharing = Nothing
Set oFolder = Nothing
Set oNamespace = Nothing
Exit Sub
ErrRoutine:
Select Case Err.Number
Case 287 ' &H0000011F
' The user denied access to the Address Book.
' This error occurs if the code is run by an
' untrusted application, and the user chose not to
' allow access.
MsgBox "Access to Outlook was denied by the user.", _
vbOKOnly, _
Err.Number & " - " & Err.Source
Case -2147467259 ' &H80004005
' Export failed.
' This error typically occurs if the CalendarSharing
' method cannot export the calendar information because
' of conflicting property settings.
MsgBox Err.Description, _
vbOKOnly, _
Err.Number & " - " & Err.Source
Case -2147221233 ' &H8004010F
' Operation failed.
' This error typically occurs if the GetCalendarExporter method
' is called on a folder that doesn't contain calendar items.
MsgBox Err.Description, _
vbOKOnly, _
Err.Number & " - " & Err.Source
Case Else
' Any other error that may occur.
MsgBox Err.Description, _
vbOKOnly, _
Err.Number & " - " & Err.Source
End Select
GoTo EndRoutine
End Sub
I need to deploy my vb.net application via group policy. I found some information on how to do this here http://windowsdevcenter.com/pub/a/windows/2006/11/14/how-to-deploy-software-using-group-policy.html.
Now I need to do the same programmatically.
Please suggest some link, document or tutorial on this.
Well,
I don't think there is documented API to create GPO. You may create it manually and then use CreateGPOLink function to link it to OU's
Just found PS script that suppose to create new GPO's, thought it may be help for you http://blogs.technet.com/b/heyscriptingguy/archive/2009/02/11/how-can-i-create-new-group-policy-objects.aspx
I think your question is answered here C# linking group policy in AD
Hope this helps. Like I said, it's ugly but it works. You'll probably have to install the Group Policy Management Console so you can add a reference to GPMGMTLib.dll. This is directly from my code so you'll have to play with it but it should get you going in the right direction:
Dim GPM As New GPMGMTLib.GPM
Dim GPMConst As GPMGMTLib.GPMConstants = GPM.GetConstants
Dim GPMDomain As GPMGMTLib.GPMDomain = GPM.GetDomain(Environment.GetEnvironmentVariable("USERDNSDOMAIN"), "", GPMConst.UseAnyDC)
Dim RootDSE As New DirectoryServices.DirectoryEntry("LDAP://RootDSE")
'Dim GPMSOM As GPMGMTLib.GPMSOM = GPMDomain.GetSOM("OU name") 'to link to specific OU
Dim GPMSOM As GPMGMTLib.GPMSOM = GPMDomain.GetSOM(RootDSE.Properties("defaultNamingContext").Value.ToString()) '//DC=domain,DC=test
'//=======================
'//see if we already exist
'//=======================
Dim GPMSearchExisting As GPMGMTLib.GPMSearchCriteria = GPM.CreateSearchCriteria
GPMSearchExisting.Add(GPMConst.SearchPropertyGPODisplayName, GPMGMTLib.GPMSearchOperation.opEquals, "Agent_Installation")
Dim GPOListExisting As GPMGMTLib.GPMGPOCollection = GPMDomain.SearchGPOs(GPMSearchExisting)
If GPOListExisting.Count <> 0 Then
MsgBox("GPO already exists.")
Exit Sub
End If
'//=============================================================================
'//copy compressed GPO template from embedded resources to filesystem then unzip
'//=============================================================================
lblStatus.Text += "Copying embedded GPO template to filesystem..." & vbNewLine
lblStatus.Refresh()
My.Computer.FileSystem.WriteAllBytes("c:\Agent_Installation_GPO.zip", My.Resources.Agent_Installation_GPO, False)
lblStatus.Text += "Extracting GPO template from archive..." & vbNewLine
lblStatus.Refresh()
Call UnZip("c:\Agent_Installation_GPO.zip", "c:\")
'//=========================================================================================
'//need to create a GPO migration table on the fly. see Create_Migration_Table() for details
'//=========================================================================================
lblStatus.Text += "Creating GPO migration table..." & vbNewLine
lblStatus.Refresh()
Call Create_Migration_Table("c:\Agent_Installation_GPO.migtable")
lblStatus.Text += "Creating GPO..." & vbNewLine
lblStatus.Refresh()
Dim GPO As GPMGMTLib.GPMGPO = GPMDomain.CreateGPO
GPO.DisplayName = "Agent_Installation"
lblStatus.Text += "Linking GPO to domain..." & vbNewLine
lblStatus.Refresh()
'//===========================
'//links the GPO to the domain
'//===========================
GPMSOM.CreateGPOLink(-1, GPO)
Dim GPMSearchCriteria As GPMGMTLib.GPMSearchCriteria = GPM.CreateSearchCriteria
GPMSearchCriteria.Add(GPMConst.SearchPropertyGPODisplayName, GPMGMTLib.GPMSearchOperation.opEquals, "Agent_Installation")
Dim GPOList As GPMGMTLib.GPMGPOCollection = GPMDomain.SearchGPOs(GPMSearchCriteria)
Dim GPMGPO As GPMGMTLib.GPMGPO = GPOList.Item(1)
lblStatus.Text += "Importing settings from template..." & vbNewLine
lblStatus.Refresh()
'//========================================================
'//link migration table to template and import all settings
'//========================================================
Dim GPMBackupDir As GPMGMTLib.GPMBackupDir = GPM.GetBackupDir("C:\Agent_Installation_GPO")
Dim GPMBackup As GPMGMTLib.GPMBackup = GPMBackupDir.GetBackup("{193E0BEE-B37E-4472-A032-F297C4A5D8E1}")
Dim GPMMigrationTable As GPMGMTLib.GPMMigrationTable = GPM.GetMigrationTable("c:\Agent_Installation_GPO.migtable")
Dim GPMResult As GPMGMTLib.GPMResult = GPMGPO.Import(0, GPMBackup, GPMMigrationTable)
lblStatus.Text += "Done"
lblStatus.Refresh()
And this this is the function that creates the migration table. For my test I used test.domain but as you can see I replace this with the current domain before I merge the XML. Note that the XML must be utf-16 or this won't work.
Using objWriter As New System.IO.StreamWriter(strPath, False, System.Text.Encoding.Unicode) '//must be utf-16
objWriter.WriteLine("<?xml version=""1.0"" encoding=""utf-16""?>")
objWriter.WriteLine("<MigrationTable xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns=""http://www.microsoft.com/GroupPolicy/GPOOperations/MigrationTable"">")
objWriter.WriteLine(" <Mapping>")
objWriter.WriteLine(" <Type>UNCPath</Type>")
objWriter.WriteLine(" <Source>\\test.domain\netlogon</Source>")
objWriter.WriteLine(" <Destination>\\" & Environment.GetEnvironmentVariable("USERDNSDOMAIN") & "\netlogon</Destination>")
objWriter.WriteLine(" </Mapping>")
objWriter.Write("</MigrationTable>")
objWriter.Close()
End Using
Is there any way to set a custom Icon of an Outlook folder or subfolder using Outlook object model?
As from Outlook 2010 you can use MAPIFolder.SetCUstomIcon as described above.
I have had the same challenge recently and found a nice snippet of VBA code at
Change Outlook folders colors possible?:
joelandre Jan 12, 2015 at 9:13 PM
Unzip the file icons.zip to C:\icons
Define the code below as Visual Basic Macros
Adapt the function ColorizeOutlookFolders according to your needs Text
Function GetFolder(ByVal FolderPath As String) As Outlook.folder
' Returns an Outlook folder object basing on the folder path
'
Dim TempFolder As Outlook.folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolder_Error
'Remove Leading slashes in the folder path
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set TempFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not TempFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = TempFolder.Folders
Set TempFolder = SubFolders.Item(FoldersArray(i))
If TempFolder Is Nothing Then
Set GetFolder = Nothing
End If
Next
End If
'Return the TempFolder
Set GetFolder = TempFolder
Exit Function GetFolder_Error:
Set GetFolder = Nothing
Exit Function End Function Sub ColorizeOneFolder(FolderPath As String, FolderColour As String)
Dim myPic As IPictureDisp
Dim folder As Outlook.folder
Set folder = GetFolder(FolderPath)
Set myPic = LoadPicture("C:\icons\" + FolderColour + ".ico")
If Not (folder Is Nothing) Then
' set a custom icon to the folder
folder.SetCustomIcon myPic
'Debug.Print "setting colour to " + FolderPath + " as " + FolderColour
End If End Sub
Sub ColorizeFolderAndSubFolders(strFolderPath As String, strFolderColour As String)
' this procedure colorizes the foler given by strFolderPath and all subfolfers
Dim olProjectRootFolder As Outlook.folder
Set olProjectRootFolder = GetFolder(strFolderPath)
Dim i As Long
Dim olNewFolder As Outlook.MAPIFolder
Dim olTempFolder As Outlook.MAPIFolder
Dim strTempFolderPath As String
' colorize folder
Call ColorizeOneFolder(strFolderPath, strFolderColour)
' Loop through the items in the current folder.
For i = olProjectRootFolder.Folders.Count To 1 Step -1
Set olTempFolder = olProjectRootFolder.Folders(i)
strTempFolderPath = olTempFolder.FolderPath
'prints the folder path and name in the VB Editor's Immediate window
'Debug.Print sTempFolderPath
' colorize folder
Call ColorizeOneFolder(strTempFolderPath, strFolderColour)
Next
For Each olNewFolder In olProjectRootFolder.Folders
' recursive call
'Debug.Print olNewFolder.FolderPath
Call ColorizeFolderAndSubFolders(olNewFolder.FolderPath, strFolderColour)
Next
End Sub
Sub ColorizeOutlookFolders()
Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\100-People", "blue")
Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\200-Projects","red")
Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\500-Meeting", "green")
Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\800-Product", "magenta")
Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\600-Departments", "grey")
Call ColorizeFolderAndSubFolders("\\Mailbox - Dan Wilson\Inbox\Customers", "grey")
End Sub
In the object ThisOutlookSession, define the following function:
Private Sub Application_Startup()
ColorizeOutlookFolders
End Sub
and
In order to NOT color sub-folders, you can use the function
ColorizeOneFolder instead of ColorizeFolderAndSubFolders e.g.
Sub ColorizeOutlookFolders()
Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\100-People", "blue")
Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\200-Projects", "red")
Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\500-Meeting", "green")
Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\800-Product", "magenta")
Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\600-Departments", "grey")
Call ColorizeOneFolder ("\\Mailbox - Dan Wilson\Inbox\Customers", "grey")
End Sub
When you move sub-folders between folders, they should retain their
color only until the next time you restart Outlook.
From what I have read this is unfortunately not possible in Outlook 2007.
It is possible in Outlook 2010 using MAPIFolder.SetCustomIcon. See MSDN for more details: http://msdn.microsoft.com/en-us/library/ff184775.aspx
Switching the list of MAPIFolder methods between 2010 and 2007 on the following MSDN webpage shows the SetCustomIcon method for 2010 only: http://msdn.microsoft.com/en-us/library/bb645002.aspx
I am trying to get uploadify to work. When I try and upload something the browse functionality works fine but there is a breif pause and then I get either an "http error" or an "IO error".
The progress bar doesn't display, which made me think it might be a path issue, but the swf file is in the same location as the images / scripts which it appears to be finding OK.
Anyone have any experience with this?
Did you use a generic handler (.ashx) for receiving the file? Here is my code
Public Class Video_File_Upload
Implements System.Web.IHttpHandler
'Dim File_Path_Chapter_Video As String = "XXX/"
Dim Directory_Videos As String = System.Configuration.ConfigurationManager.AppSettings("Videos_Save")
Sub ProcessRequest(ByVal context As HttpContext) Implements IHttpHandler.ProcessRequest
context.Response.ContentType = "text/plain"
context.Response.Expires = -1
Try
Dim postedFile As HttpPostedFile = context.Request.Files("Filedata")
Dim filename As String = postedFile.FileName
'string folderName = context.Request.QueryString["FolderName"];
Dim NOF As String
Dim CheckFilePath As String
Dim MapPath As String
NOF = Convert.ToString(context.Request("NOF"))
CheckFilePath = Directory_Videos & NOF
If Directory.Exists(CheckFilePath) = False Then
Directory.CreateDirectory(CheckFilePath)
End If
MapPath = Directory_Videos & NOF & "/" & filename
postedFile.SaveAs(MapPath)
Catch
End Try
End Sub
ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable
Get
Return False
End Get
End Property
End Class
Then you have to put this line in the upload setting: "uploadScript:Video_File_Upload.ashx"