Accessing a folder with only numbers in its name from Outlook VBA? - vba

In an existing mailbox folder hierarchy, there is a folder containing subfolders named "01", "05", "06", etc. Notice that the numbers are not consecutive: "02", "03", "04" are missing in this example. In my VBA code, I need to check whether a folder named, say, "02" exists and if not, create it.
I currently have (stripped to bare minimum):
Dim NameStr as String
NameStr="02"
On Error Resume Next
Set NewSubFolder = ContainerFolder.folders(NameStr)
On Error GoTo 0
If NewSubFolder Is Nothing Then
Set NewSubFolder = ContainerFolder.folders.Add(NameStr)
End If
As long as NameStr contains an alphanumeric string, or a numbers-only string with value larger than the count of items if ContainerFolder (such as "2020"), everything works. However, if NameStr is set to "02" (or other value low enough to be interpeted as sequence number of an existing subfolder), the first set statement, instead of failing and returning Nothing, returns a pointer to the third folder (counting from zero, 02 corresponds to 3rd item) in the container folder. That would be "06" in the example above. No folder named "02" will be created.
Apparently the VBA interpreter "kindly" converts the string "02" to integer 2, and then returns pointer to the third folder. How do I prevent this behaviour?
How do I force Outlook to check for existence of a folder with only digits in its name?

The result of On Error Resume Next is often non-working code. You may want to apply it as a last resort.
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
'
' If desperate declare as variant
Sub createFolder_MinimalVerifiableExample_Dangerous_OnErrorResumeNext_TheOtherWay()
Dim containerFolder As folder
Dim newSubFolder As folder
Dim nameStr As String
nameStr = "03"
Set containerFolder = Session.GetDefaultFolder(olFolderInbox)
On Error Resume Next
' Bypass error if folder exixts
Set newSubFolder = containerFolder.folders.Add(nameStr)
On Error GoTo 0
End Sub

The Folders takes a string representing the folder name or just an index number. To be sure you will get the folder you can iterate over all subfolders and check the folder name. Following this way you can be sure you will get what you need.

Based on niton's response as well as others' contributions, here is my solution.
Instead of trying to get a pointer to the folder, and if that fails, create the folder, lets try to create the folder first, ignore the error if the folder is already there, and then get the pointer no matter whether the folder pre-existed or was newly created.
Dim containerFolder As folder
Dim newSubFolder As folder
' containerFolder needs to point to a valid folder (code not shown)
Dim nameStr As String
nameStr = "03"
On Error Resume Next
Set newSubFolder = containerFolder.folders.Add(nameStr)
On Error GoTo 0
Set newSubFolder = containerFolder.folders.Item(nameStr)
The .Item part in the last statement is optional.
Many thanks to all contributors!

Related

Using 'FileLen' with a four digit file extension

I am working on a routine that gets the filelength for each of a large number of image files. When the routine runs file length against most files it works perfectly but some of the images have the file extension '.jpeg' and the FileLen command produces a 'File not found' error for these files. The code line I'm using is:
ActiveCell.Offset(ColumnOffset:=2).Value = FileLen(D & N)
Where D is a text variable containing the Drive Letter and N is a text variable containing the path and filename.
I have tested the string variables and they are supplying the correct full path and filename to the FileLen command. I have also set up a test routine to check with other files and this produces the same result. Am I correct in assuming that FileLen does not work with 4 digit file extensions? Is there a simple way round the issue?
The routine will be checking and comparing around 240,000 files with a fair proportion being .jpeg so going in and changing the extensions isn't an option.
Rob
FileLen can handle extensions with more than 3 characters, so that's not your problem.
Assuming that your values for D and N are correct (you should consider to use more meaningful names for your variables), I can imagine that it may be confused because of interference between short and long name of a file, but I cannot prove this.
You could try to use the FileSystemObject as alternative. Add a reference to the scripting runtime and use:
Option Explicit
Dim fso As FileSystemObject
Function getFSO() As FileSystemObject
' Create object only if neccessary
If fso Is Nothing Then Set fso = New FileSystemObject
Set getFSO = fso
End Function
Function getFilesize(filename As String) As Long
' Return the size of a file or -1 if not found or any error
getFilesize = -1
On Error Resume Next
getFilesize = getFSO.GetFile(filename).Size
On Error GoTo 0
End Function
Usage:
ActiveCell.Offset(ColumnOffset:=2).Value = getFilesize(D & N)

Random File Selector?

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

Editing hyperlink to remove file name from path

I'm trying to alter hyperlinks within an open Outlook email to remove the filename from the path. For example I want A:\test\folder1\file.txt to become A:\test\folder1
We use SharePoint Online to store files and often want to open the file location instead. Modifying the link makes this happen (we have SharePoint mapped as a network share).
This code alters the entire hyperlink. I assume I need to discard everything after the final backslash.
Sub HyperLinkChange()
Dim objDoc As Object
Dim tmpLink As Object
On Error Resume Next
If ActiveInspector.EditorType = olEditorWord Then
' use WordEditor Inspector
Set objDoc = ActiveInspector.WordEditor
For Each tmpLink In objDoc.Hyperlinks
tmpLink.Address = "test123"
Next tmpLink
End If
End Sub
You can use the InStrRev to search for a backslash starting from the end, and Left function to truncate your string. For more detail, see the InStrRev documentation and Left documentation.
After adding an additional variable Dim pos as Long, find the position of the last backslash with pos = InStrRev(tmpLink.Address, "\", , vbTextCompare). This is the postion starting from beginning of the address text, not the end. In your example address A:\test\folder1\file.txt, the position of the last backslash is 16.
Then tmpLink.Address = Left(tmpLink.Address, pos - 1) returns everything to the left of that backslash.

Outlook 2010 scripted rule using VBA

I am trying to create a very simple (because I'm new and learning) scripted rule in Outlook 2010.
The RULE is: If a new mail item comes in from a particular email address, run my script and stop processing rules. The SCRIPT checks the body for a string. If the string is found, it moves the email to destination folder 1, otherwise it moves it to destination folder 2.
Sadly, I can't seem to get the script (code below) to do anything (mail just goes to inbox rather than either folder specified in script). A lot of this was pieced together from online examples, so I don't understand it all, but I figure I'd ask this now while I research the stuff I don't get. Any ideas on how to get this to work as intended?
'Use the MailItem class of item
Public Sub NCRFRule(Item As Outlook.MailItem)
Dim MAPI As NameSpace 'Don't know what this does
Dim dest1, dest2 As Folder 'declare destination folders
Dim newMail As MailItem 'set item type
'Don't know what this does.
Set MAPI = GetNamespace("MAPI")
'Set the destination folders
Set dest1 = MAPI.Folders("Inbox").Folders("NCRFs")
Set dest2 = MAPI.Folders("Inbox").Folders("other's NCRFs")
'Rule if-statement. If text is found, move mail to dest1 folder
If InStr(1, newMail.Body, "Your Required Action") <> 0 Then
newMail.Move dest1
GoTo cutOut:
End If
'If the above If-statement doesn't execute, text wasn't found,
'move mail to other destination folder.
newMail.Move dest2
cutOut:
End Sub
Note: this code is in the "ThisOutlookSession" module.
MAPI.Folders("Inbox")
There is no such folder. Use the GetDefaultFolder method of the Namespace or Store class instead.
Also you may find the Getting Started with VBA in Outlook 2010 article helpful.
Building on What Eugene explained, changing
Set dest1 = MAPI.Folders("Inbox").Folders("NCRFs")
Set dest2 = MAPI.Folders("Inbox").Folders("other's NCRFs")
to
Set dest1 = MAPI.GetDefaultFolder(olFolderInbox).Folders("NCRFs")
Set dest2 = MAPI.GetDefaultFolder(olFolderInbox).Folders("other's NCRFs")
got that part to work. Then I had to remove the line
Dim newMail As MailItem 'set item type
and replace all instances of "newMail" with "Item". Now it works!

Implement auto-increment with Word macro

I'm writing a Word/VBA macro for a document template. Every time a user saves/creates a new document from the template, the document needs an ID embedded in the text. How can I (as simple as possible) implement auto-increment for this ID? The ID is numeric.
The system has to have some kind of mechanism to avoid different documents getting the same IDs, but the load is very low. About 20 people will use this template (on our intranet), creating something like 20 new documents a week altogether.
I've toyed with the idea of having a text file that I lock and unlock from the macro, or call a PHP page with an SQLite database, but is there other, smarter solutions?
Note that I can't use UUID or GUID, since the IDs need to be usable by humans as well as machines. Our customers must be able to say over the phone: "... and about this, then, with ID 436 ...?"
Gave some further thought to this, and here is another approach you may want to consider. If you're not interested in a catalog of previous IDs, then you could simply use a custom document property to store the last ID that was used.
In Word 97-2003, you can add a custom property by going to "File / Properties", choosing the custom tab and assigning a name and value there. Adding a custom document property in Word 2007 is a bit more buried and off the top of my head, I think it's "Office Button / Prepare / Document Properties", choose the little drop down box for advanced properties and you'll get the same ol' pre-2007 dialog.
In the example below, I called mine simply "DocumentID" and assigned it an initial value of zero.
The relevant bit of code to update a Custom document property is:
ThisDocument.CustomDocumentProperties("DocumentID").Value = NewValue
As a proof of concept, I created a .dot file and used the following code in the Document_New() event:
Sub UpdateTemplate()
Dim Template As Word.Document
Dim NewDoc As Word.Document
Dim DocumentID As DocumentProperty
Dim LastID As Integer
Dim NewID As Integer
'Get a reference to the newly created document
Set NewDoc = ActiveDocument
'Open the template file
Set Template = Application.Documents.Open("C:\Doc1.dot")
'Get the custom document property
Set DocumentID = Template.CustomDocumentProperties("DocumentID")
'Get the current ID
LastID = DocumentID.Value
'Use any method you need for determining a new value
NewID = LastID + 1
'Update and close the template
Application.DisplayAlerts = wdAlertsNone
DocumentID.Value = NewID
Template.Saved = False
Template.Save
Template.Close
'Remove references to the template
NewDoc.AttachedTemplate = NormalTemplate
'Add your ID to the document somewhere
NewDoc.Range.InsertAfter ("The documentID for this document is " & NewID)
NewDoc.CustomDocumentProperties("DocumentID").Value = NewID
End Sub
Good luck!
You could handle this entirely through VBA using Word and Excel (or Access I suppose, but I have an unnatural aversion towards using Access).
First, create a new Excel workbook and store it in a location that you can access through your word document (mine is C:\Desktop\Book1.xls). You may even want to seed the values by entering a numeric value into cell A1.
In your word document, you would enter this into your Document_Open() subroutine:
Private Sub Document_Open()
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlRange As Excel.Range
Dim sFile As String
Dim LastID As Integer
Dim NewID As Integer
'Set to the location of the Excel "database"
sFile = "C:\Desktop\Book1.xls"
'Set all the variables for the necessary XL objects
Set xlApp = New Excel.Application
Set xlWorkbook = xlApp.Workbooks.Open(sFile)
'The used range assumes just one column in the first worksheet
Set xlRange = xlWorkbook.Worksheets(1).UsedRange
'Use a built-in Excel function to get the max ID from the used range
LastID = xlApp.WorksheetFunction.Max(xlRange)
'You may want to come up with some crazy algorithm for
'this, but I opted for the intense + 1
NewID = LastID + 1
'This will prevent the save dialog from prompting the user
xlApp.DisplayAlerts = False
'Add your ID somewhere in the document
ThisDocument.Range.InsertAfter (NewID)
'Add the new value to the Excel "database"
xlRange.Cells(xlRange.Count + 1, 1).Value = NewID
'Save and close
Call xlWorkbook.Save
Call xlWorkbook.Close
'Clean Up
xlApp.DisplayAlerts = True
Call xlApp.Quit
Set xlWorkbook = Nothing
Set xlApp = Nothing
Set xlRange = Nothing
End Sub
I realize this is a tall procedure, so by all means re-factor it to your heart's content. This was just a quick test I whipped up. Also, you'll need to add a reference to the Excel Object Library through References in VBA. Let me know if you have any questions about how that works.
Hope that helps!
Well you have to store the next ID number somewhere. The text file idea is as good as any. You just have to handle the possibility of it being locked or unaccessible for some reason.
Using a database for one number is overkill.
Off the top of my head:
Use Excel as your external DB with Automation.
Explore the several SQLite COM wrappers (Litex comes to mind).
"text file that I lock and unlock from the macro" would be the safest approach.
The DOCID file would only have one number: the last ACTUALLY used ID.
A) You read the file (not in write/append mode) and store on a variable on your document DOC_ID =FILE_ID+1 and save the doc. Tentatively you kill the DOCID file, open/create for read-write sotring your DOC_ID. Close the file. If all went well including Close, you're safe, otherwise, back to A).
You might want to consider: if no file is found create it with this document ID +100, as a measure of recovering from no-UPS disasters whilst in A)
I'm too tired to check if it might create a deadlock under concurrency scenario... it might.
If you feel its worth it, I can put code here.
It seems I found a way to open and update a text file with exclusive rights, which means that there will be no concurrency problems:
Private Function GetNextID(sFile As String) As Integer
Dim nFile As Integer
nFile = FreeFile
On Error Resume Next
Open sFile For Binary Access Read Write Lock Read Write As #nFile
If Err.Number <> 0 Then
' Return -1 if the file couldn't be opened exclusively
GetNextID = -1
Err.Clear
Exit Function
End If
On Error GoTo 0
GetNextID = 1 + Val(Input(LOF(nFile), #nFile))
Put #nFile, 1, CStr(GetNextID)
Close #nFile
End Function
Simply call this function until it doesn't return -1 anymore. Neat.