I'm now tasked with a massive project to import and reorganize about 50 outlook pst archives (probably around 100-200GB) into a single library account for my freight forwarding company.
I'm using a Windows 10 Pro computer with Office 365 Business Premium installed on the local machine and Outlook is using a current "Exchange Online" version 15.20.xxxx.xx so everything is available in the cloud.
The importing of archives isn't a problem.
My problem is having to rename several thousand outlook folders so they are organized!
End Goal is to have all email folders renamed starting with the full file number our company software set for this shipment:
CHI-AE0xxxxx (air export)
CHI-AI0xxxxx (air import)
CHI-OE0xxxxx (ocean export)
CHI-OI0xxxxx (ocean import)
CHI-DO0xxxxx (domestic)
where the x's are numeric and must now be 6 numbers
Until now, there was no naming structure, so everyone uses whatever made sense in their personal brain. Here's some examples:
CHOIxxxxx
CHOI0xxxxx
CHIOIxxxxx
CHIOI0xxxxx
or just xxxxx (I'll know what prefix needs to get attached to this person's folders)
So basically what I'm wanting to do is replace "CHOI" or "CHIOI" with "CHI-OI" and then if there's 5 digits, turn it into 6 digits with a leading 0.
I'm very experienced with Excel VBA and Macros.
I'm pretty good at using Powershell with Excel and SQL Server Databases.
I have no experience with Outlook and/or attempts to manipulate it with external tools like VBA or Powershell, but I'm willing to learn!
Turns out Outlook VBA was the way to go for this task.
I finally found a great answer yesterday:
https://www.datanumen.com/blogs/batch-find-replace-specific-words-outlook-folder-names/
I had to modify the code a little by replacing:
Set objFolders = Outlook.Application.Session.Folders("Personal").Folders
With this so it searches / modifies only the subfolders within the folder I currently have selected:
Set objFolders = Outlook.Application.ActiveExplorer.CurrentFolder.Folders
Here's the (almost) finished code:
Public strFind, strReplace As String
Sub FindReplaceWordsinFolderNames()
Dim objFolders As Outlook.Folders
Dim objFolder As Outlook.Folder
Set objFolders = Application.ActiveExplorer.CurrentFolder.Folders
'You need to input the specific words for find and replace
strFind = InputBox("Enter the specific words you want to change.")
strReplace = InputBox("Enter the specific words you want to change to. (Case Sensitive)")
For Each objFolder In objFolders
Call ProcessFolders(objFolder)
Next
MsgBox "Complete!", vbExclamation, "Rename Folders"
End Sub
Private Sub ProcessFolders(ByVal objCurrentFolder As Outlook.Folder)
Dim objSubfolder As Outlook.Folder
On Error Resume Next
If InStr(LCase(objCurrentFolder.Name), LCase(strFind)) > 0 Then
'Find and replace the specific words
objCurrentFolder.Name = Replace(LCase(objCurrentFolder.Name), LCase(strFind), strReplace)
End If
'Process all folders recursively
If objCurrentFolder.Folders.Count > 0 Then
For Each objSubfolder In objCurrentFolder.Folders
Call ProcessFolders(objSubfolder)
Next
End If
End Sub
It doesn't have any error checking, so if I click cancel in inputbox or leave it blank and click ok, the macro will act like "" is the strFind, so it then turns all folder names into all lower case, lol.
I think adding this just after the 2 inputboxes will solve it, but I'll test that tomorrow:
If strFind = "" Or strReplace = "" Then
Exit Sub
End If
This solution seems really good for me, as there are so many varieties of search strings I need to address, that hard coding each one would have been a nightmare. Instead, this will allow me to adjust on the fly to how each user's brain was working when they developed their personal naming structures over the years.
After seeing and using this, I then developed another macro to batch move everything from the selected directory to whatever folder I wish to merge them into ... to create my true library of files, but that's a different topic so I suppose you don't want that posted in here.
Related
It's been years since I've used Visual Basic. I downgraded from 2017 to 2010 (The version I was using while I was in school). I figured VB would be the best way to attempt a solution. (Although I'm sure there are other languages that would do it as well.)
I'm looking to get back into programming. Let me get to the problem.
My friend has an ever growing amount of text documents in a folder, and he wants a program to choose one at random, and open it.
I thought I'd put a TextBox with a Button that would let him open the folder where he stores his files. Then this program would read the number of text files in that folder, and randomly generate a number between one and that number, select, and open the document with its default program (if it's text, notepad; if it's DocX then word.)
I've been sitting at a blinking cursor for 45 minutes. I've gone on YouTube for help with this project.
Any advice, or help you guys can give me? Does this need to be simplified?
That sounds like a reasonable strategy to me.
It might be worth displaying some sort of progress to the user, say by putting the name of current file name being read into the status bar, in case there's a long delay reading the file names due to the large number of files in the folder, and/or a slow-running network drive. If you do this, remember to put a DoEvents into your loop to allow screen updates to display.
There's a separate thread on how to open files in their native handler here.
Hope this helps - good luck!
Option Explicit
Public oFSO As Object
Public arrFiles()
Public lngFiles As Long
Sub Main()
Dim sPath As String
sPath = InputBox("Enter folder path", "Folder path")
' clear starting point
lngFiles = 0
Erase arrFiles
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call recurse(sPath)
Randomize
Dim lngRandomFileNumber As Long
lngRandomFileNumber = CLng(lngFiles * Rnd) + 1
MsgBox "This is random file, that will be opened: " & arrFiles(lngRandomFileNumber)
Call CreateObject("Shell.Application").Open(arrFiles(lngRandomFileNumber))
End Sub
Sub recurse(sPath As String)
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFolder = oFSO.GetFolder(sPath)
'Collect file information
For Each oFile In oFolder.Files
lngFiles = lngFiles + 1
ReDim Preserve arrFiles(lngFiles + 1)
arrFiles(lngFiles) = sPath & "\" & oFile.Name
Next oFile
'looking for all subfolders
For Each oSubFolder In oFolder.SubFolders
'recursive call
Call recurse(oSubFolder.path)
Next oSubFolder
End Sub
You can paste this code in any VBA supporting application (MS Access, MS Excel, MS Word), call VBA editor (Shift + F11) and paste this code. After that press F5 and select Main() function. You'll see prompt to enter folder path, and after that you would get random file path.
I think it should be understandable in practice to see what program do
Updated: #Belladonna mentioned it clearly, to open file in default program.
NB: This code is passes through subfolders also, if you want to exclude subfolders, you should comment the recursive call block in recurce function
Prior to being asked to migrate to SharePoint, I was using a collection of .xlsm files to set project teams up to manage projects. My Project Manager file included a macro that would go to a designated folder and create hyperlinks for all current project files. I've saved the collection of .xlsm files on SharePoint, but when I run the macro below (which I found here - Thank you!), I receive an error related to the "Set xFolder = xFSO.GetFolder(xPath)" line. Any help would be great. I've read several posting that may have the answer and tried several adjustments to the code, with no luck.
Sub Create_Hyperlinks_for_all_Current_Projects()
Range("B8:D38").Clear
MsgBox "Once you click OK, an explorer box will appear. Select the folder
containing all the CSTPs and then click OK again. HINT: The folder
containing all the CSTPs should be in the same folder this document was in
and should be called ''CSTPs''. Links to all CSTPs will then appear in the
white box on the Manager Menu."
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim I As Integer
Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
With xFiDialog
.InitialFileName = ThisWorkbook.Path
End With
If xFiDialog.Show = -1 Then
xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
For Each xFile In xFolder.Files
I = I + 2
ActiveSheet.Hyperlinks.Add Cells(I + 6, 2), xFile.Path, , , xFile.Name
Next
End Sub
I hope you find the following notes helpful.
They summarize the outcomes from several weeks of frustration.
If you are using SP365,
then the filesystemobject
no longer works very well, if at all.
I had hundreds of macros dependent on the FSO.
These have all worked great up until my organization migrated to SP365 :o(
Now they only work if I manually click
the Open Explorer button, in SP, first.
Opening Explorer provides Win Explorer with the required permissions to access SP.
This in turn provides the FSO with the required permissions to access SP.
But...in my case...FSO only works for a while.
For my first work around...
I rolled out a prototype app, which used a macro to automate
opening IE, opening Win Explorer and initializing permissions for the FSO
All worked great on my machine, for about an hour,
then some kind of timeout took me back to square one.
Colleagues on other machines experienced a range of FSO behaviours.
From all working ok. To having to rerun the connection macro every 30 seconds.
To nothing working at all.
I then invested time trying to update macros to connect to SP as a network drive.
Again, this is a process that I have used for years, up until migration to SP365.
Again, success connecting to SP365 seems to be very machine dependent.
In the end...with respect to my own requirements...
My work around was to create an SP view that lists all files.
Then use the Export to Excel option in SP to create an Excel data query.
Then copy the query into an Excel file that I refer to as Config.xlsx.
Then use Excel RefreshAll to update the list of files, each time a list is required.
Its not very elegant...but, it works ;o)
As I say....I hope this helps you / someone.
Feel free to connect on LinkedIn if you require any followup advice.
Peter,
LinkedIn name DrPeterEHSmee
I have VBA code in Outlook I use to send specific emails (with three asterics in the subject line) to the deleted folder after sent in 'This Outlook Session'.
It works correctly when Outlook is first opened, and all day long, however, the next day I find at some point overnight the VBA code has failed to function and only functions properly again if I close \ re-open Outlook??
This only started to occur when the company moved to the 2007 & 2010 versions.
I need it to run constantly on sent mail as I have early am batch processes that send out a lot of emails that I want to have removed from sent folder and placed in the deleted folder after eachis sent as this code does.
Here is the code. Since it worked well before, I can only assume the newer Outlook versions need some additional trigger to keep 'This Outlook Session' open or something of that nature.
Any thoughts would be appreciated.
Option Explicit
Private WithEvents olSentItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub olSentItems_ItemAdd(ByVal Item As Object)
If Item.Class = olMail And InStr(1, Trim(Item.Subject), " * * * ", vbTextCompare) > 0 _
Then
Item.Delete
End If
End Sub
I suggest that you have a look at the Trust Center Settings >> Macros. Office 2003 has it in a different way and it is all new after Office 2003.
Try different settings and see which one fits your need. They are totally four setting levels.
Also it is good idea to use only one version of Outlook. Don't interchange between 2007 and 2010 if you have both of them. Outlook versions cannot co exist with creation of bugs.
This page should be able to give me more details.
Click Here
I have a number of large Microsoft Word documents with many linked files from many Microsoft Excel spreadsheets. When opening a Word document, even with the 'update linked files at open' option unchecked:
Word still checks each link at its source by opening and closing the relevant excel spreadsheet for each individual link (so for x number of links, even if from the same spreadsheet, Word will open and close the spreadsheet x times). This means opening documents takes a very long time.
I have found that documents open faster if the spreadsheets containing the source of linked objects are already open, so Word doesn't keep opening, closing, reopening them.
So far, the beginnings of a solution I have is to create a list of all the filepaths of the linked objects, done by following VBA code:
Sub TypeArray()
Dim List(), Path As String
Dim i, x As Integer
Dim s As InlineShape
Dim fso As FileSystemObject, ts As TextStream
Set fso = New FileSystemObject
Set ts = fso.OpenTextFile("C:\MyFolder\List.txt", 8, True)
With ts
.WriteLine (ActiveDocument.InlineShapes.Count)
End With
For Each s In ActiveDocument.InlineShapes
Path = s.LinkFormat.SourcePath & "\" _
& s.LinkFormat.SourceName
With ts
.WriteLine (Path)
End With
Next s
End Sub
'--------------------------------------------------------------------------------------
Private Sub WriteStringToFile(pFileName As String, pString As String)
Dim intFileNum As Integer
intFileNum = FreeFile
Open pFileName For Append As intFileNum
Print #intFileNum, pString
Close intFileNum
End Sub
'--------------------------------------------------------------------------------------
Private Sub SendFileToNotePad(pFileName As String)
Dim lngReturn As Long
lngReturn = Shell("NOTEPAD.EXE " & pFileName, vbNormalFocus)
End Sub
which works well, but can only be used after a document is already open, which defeats its purpose.
So, finally, my question(s) are these:
1) Is there a way to run this code (or any better, more efficient code - suggestions are welcome) before opening a Word document and waiting through the long process of checking each link at its source?
2) Is there a way to avoid all this and simply have Word not check the links when it I open a document?
Sorry for the long question, and thank you for the help!
If I am not wrong there should be Document_Open event according to msdn. This should actually be a before open document and should be fired before updating links (at least it in excel it is fired before calculation).
Try opening the files on document open. Then you will face another problem, and so when to close the files, but that is a much easier thing to do. (probably document_close event...)
EDITTED:
As comments state, this is too late. You can create a word opener (as a single app or as an addin). The logic basically is:
'1) on something_open run GetOpenFileName dialog
'2) before opening the real thing, open all files accompanied
'3) open the document itself
'4) close all files
'5) close the opener itself
This is not the most trivial way, but I use this logic for exampe to make sure, that my applications always runs in a fresh copy of excel etc. But I understand that this is a workaround rather then a solution.
If you are still looking for something on this front, I created the following in a combination of VBA and VB.NET (in VS 2010) to show what can be done quite easily using that system. If VB.NET is no use to you, sorry, but there are reasons why I don't really want to spend time on the pure VBA approach.
At present, it is a "console" application which means you'll probably see a box flash up when it runs, but also means that you are more likely to be able to create this app without VS if you absolutely had to (AFAICR the VB.NET /compiler/ is actually free). It just fetches the link info. (i.e. there's currently no facility to modify links).
The overview is that you have a small piece of VBA (say, in your Normal template) and you need an open document. The VBA starts a Windows Shell, runs the VB.NET program and passes it the full path name of the document you want to open.
The VB.NET program opens the .docx (or whatever) and looks at all the Relationships of type "oleObject" that are referenced from the Main document part (so right now, the code ignores headers, footers, footnotes, endnotes and anywhere else you might have a link)
The VB.NET program automates Word (which we know is running) and writes each link URL into a sequence of Document Variables in the active document. These variables are called "Link1", "Link2", etc. If there are no links (I haven't actually tested that path properly) or the program can't find the file, "Link0" should be set to "0". Otherwise it should be set to the link count.
The shell executes synchronously, so your VBA resumes when it's done. Then you either have 0 links, or a set of links that you can process.
The VBA is like this:
Sub getLinkInfo()
' the full path name of the program, quoted if there are any spaces in it
' You would need to modify this
Const theProgram As String = """C:\VBNET\getmaindocumentolelinks.exe"""
' You will need a VBA reference to the "Windows Script Host Object Model"
Dim oShell As WshShell
Set oShell = CreateObject("WScript.Shell")
' plug your document name in here (again, notice the double quotes)
If oShell.Run(theProgram & " ""c:\a\testdocexplorer.docx""", , True) = 0 Then
With ActiveDocument.Variables
For i = 1 To CInt(.Item("Link0").Value)
Debug.Print .Item("Link" & CStr(i))
Next
End With
Else
MsgBox "Attempt to retrieve links failed"
End If
End Sub
For the VB.NET, you would need the Office Open XML SDK (I think it's version 2.5). You need to make references to that, and Microsoft.Office.Interop.Word.
The code is as follows:
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.IO
Imports System.Xml
Imports System.Xml.Linq
Imports DocumentFormat.OpenXml.Packaging
Imports Word = Microsoft.Office.Interop.Word
Module Module1
Const OLEOBJECT As String = "http://schemas.openxmlformats.org/officeDocument/2006/relationships/oleObject"
Sub Main()
Dim s() As String = System.Environment.GetCommandLineArgs()
If UBound(s) > 0 Then
Dim wordApp As Word.Application
Try
wordApp = GetObject(, "Word.Application")
Dim targetDoc As Word.Document = wordApp.ActiveDocument
Try
Dim OOXMLDoc As WordprocessingDocument = WordprocessingDocument.Open(path:=s(1), isEditable:=False)
Dim linkUris As IEnumerable(Of System.Uri) = From rel In OOXMLDoc.MainDocumentPart.ExternalRelationships _
Where rel.RelationshipType = OLEOBJECT _
Select rel.Uri
For link As Integer = 0 To linkUris.Count - 1
targetDoc.Variables("Link" & CStr(link + 1)).Value = linkUris(link).ToString
Next
targetDoc.Variables("Link0").Value = CStr(linkUris.Count)
OOXMLDoc.Close()
Catch ex As Exception
targetDoc.Variables("Link0").Value = "0"
End Try
Finally
wordApp = Nothing
End Try
End If
End Sub
End Module
I originally wrote the .NET code as a COM object, which would be slightly easier to use from VBA, but significantly harder to set up on the .NET side and (frankly) much harder to modify & debug as you have constantly to close Word to release the references to the COM DLLs.
If you actually wanted to fix up the LINK paths, as far as I can tell, modifying them in the relationship records is enough to get Word to update the relevant LINK fields when it opens Word, which saves having to modify the XML code for the LINK fields as well. But that's another story...
I just found out that you can set/modify a DelayOleSrvParseDisplayName registry entry and a NoActivateOleLinkObjAtOpen registry entry to modify the global behaviour:
See http://support.microsoft.com/kb/970154
I also found that activedocument.fields can contain links to external objects (in my case, an Excel sheet).
Use this code to parse them:
for each f in activedocument.fields
debug.print f.code
next
And use activedocument.fields(FIELDNUMBER) to select each object, to figure out where it is in the document.
Maybe also activedocument.Variables and activedocument.Hyperlinks can contain links to external objects? (not in my case).
I apply a default string to the beginning of the Subject field with all new emails.
I have two Outlook user accounts/PST files - personal & business. I want the Subject string added to emails only when I'm working in the business account.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If MsgBox("Send with 'Myrtleford Festival" at start of subject?", vbYesNo, "Send as Festival mail") = vbYes Then
If (Left(Trim(Item.Subject), 11)) <> "The " Then
Item.Subject = "The Myrtleford Festival 2012/ " + Item.Subject
End If
End If
End Sub
This is the basis of an approach.
It is sometime since I have had multiple accounts but, when I did, the top level folders were very different. The code below outputs to the Immediate window the names of the top level folders. On my current system this would give:
Personal Folders
Archive Folders
Test Folders
If your two accounts have different top level folders, you could distinguish your accounts from that.
If you like this approach but the top level folders are the same, I have a routine that searches for a specific folder at any depth in the hierarchy. Even if the main folders are the same, I assume some of the sub-folders are different.
Sub AnswerA()
Dim InxIFLCrnt As Integer
Dim TopLvlFolderList As Folders
Set TopLvlFolderList = _
CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
For InxIFLCrnt = 1 To TopLvlFolderList.Count
Debug.Print TopLvlFolderList(InxIFLCrnt).Name
Next
End Sub
OK, cool. In fact I stumbled on a totally foolproof & elegant solution. In Outlook's Trust Centre>Macro Security, I selected the option for "warn for all macros". Now when I open Outlook to any of my profiles, I get a pop-up asking if I want to enable/disable macros. Since the VBA script is the only macro running, I can easily filter whether the default subject string is used. Which will work 100% of the time forever (since I can't see any reason why I'll ever be using another macro/VBA script)