



'Set objDestFolder = objNameSpace.PickFolder 'Set objDestFolder = objNameSpace.Folders("Mailbox - _NAME_").Folders("_FOLDER_") Set objDestFolder = objInbox.Folders("_FOLDER_") Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox) Set objNameSpace = Application.GetNamespace("MAPI") Un-comment as you please, the folder selector, etc.) Sub ArchiveMessage1() (Replace _FOLDER_ and _NAME_ with the name of a folder, and the name on the mailbox, respectively.
USEFUL MICROSOFT WORD MACROS ARCHIVE
This is less useful now that Outlook has an ARCHIVE button. OFolder.ShowItemCount = olShowTotalItemCount Private Sub ShowTotalInFolders(ByVal Root As Outlook.Folder) If Not (LCase(Left(Trim(TypeName(oBFF)), 6)) = "folder") ThenĮnd Function To change all folders to show TOTAL messages and not UNREAD Sub ShowTotalInAllFolders()įor Each oStore In Set oBFF = oShell.BrowseForFolder(0, sMsg, cBits, xRoot) SMsg = "Select a Folder To Output The Attachments To" Set oShell = CreateObject("shell.application") Public Function GetOutputDirectory() As String
USEFUL MICROSOFT WORD MACROS CODE
'Found this code in a google groups thread here: Error " + Err.Number + " " + Err.DescriptionĮrrResult = MsgBox(errMsg, vbAbortRetryIgnore, "Error in Save Attachments") MsgBox doneMsg, vbOKOnly, "Save Attachments"ĮrrMsg = "An error has occurred. 'Save it to disk if the file does not existĭoneMsg = "Completed saving " + Format$(AttTotal, "#,0") + " attachments in " + Format$(MsgTotal, "#,0") + " Messages." That will be a flag not to write the file Please enter a new name, or hit cancel to skip this one file.", "File Exists", outputFile) + " already exists in the destination directory of " _ OutputFile = InputBox("The file " + outputFile _ Set att = Sel.Item(cnt).Attachments.Item(AttachmentCnt)įileExists = fso.fileExists(outputDir + outputFile) If Sel.Item(cnt).Attachments.Count > 0 Thenįor AttachmentCnt = 1 To Sel.Item(cnt).Attachments.Count 'Loop thru each selected item in the inbox Exiting SaveAttachments.", vbCritical, "SaveAttachments" MsgBox "You must pick an directory to save your files to. 'Visual Basic editor -> Tools -> References. 'Requires reference to Microsoft Scripting Runtime (SCRRUN.DLL) 'Run this in a folder containing e-mail messages. To save all attachments in all selected messages. I also have a few useful Microsoft Word macros.
