MemoryUsed Property

I'd never come across this before and it doesn't appear in the IntelliSense drop-down, but it is quite a neat way of monitoring the current workbook size.

Per the MSDN page here:

This example displays a message box showing the number of bytes that Microsoft Excel is currently using.

MsgBox "Microsoft Excel is currently using " _
                  Application.MemoryUsed & " bytes"

Find and replace VBA code using VBA

It is sometimes necessary to update your code, a quick find and replace (Ctrl+H) will often be enough.  I’d also recommend the MZ Tools VBE toolbar, it has a lot to add to your VBA coding experience, including a very good search tool.

Sometimes the above is not quite want you want.  So below is a simple bit of code you can use to replace one line of code for another.

Public Sub FindAndReplace()
'-----------------------------------------------------------------------------' Procedure : FindAndReplace
' Purpose   : Searches the active workbook for a specific code line and
'             replaces it with a new code line
'-----------------------------------------------------------------------------
    Dim SL As Long, EL As Long, SC As Long, EC As Long
    Dim S As String
    Dim Found As Boolean
    Dim sFind As String
    Dim sReplace As String

    sFind = "my old line of code"
    sReplace = "my new line of code"

    With ActiveWorkbook.VBProject.VBComponents("MyCodeModule").CodeModule
        SL = 1
        SC = 1
        EL = 99999
        EC = 999
        Found = .Find(sFind, SL, SC, EL, EC, True, False, False)
        If Found = True Then
            S = .Lines(SL, 1)
            S = Replace(S, sFind, sReplace)
            .ReplaceLine SL, S
        End If
    End With

End Sub

SL / SC is the start line / start column and EL / EC is the end line / end column.  These can be changed to target code lines within a specific part of your code.

I hope the above proves useful.  As always, any questions let us know via the comments.

Checking odd and even numbers in VBA

It is sometimes useful to be able to check whether a number is odd or even.

Below is a very simple VBA function that does exactly that:

Function IsOdd(x As Integer) As Boolean
'------------------------------------------------------------------------
' Procedure : IsOdd
' Author : Zypher.co.uk
' Date : 09-Feb-2012
' Purpose : Check whether a value is odd or even
'------------------------------------------------------------------------
   IsOdd = (x Mod 2) <> 0
End Function

As always, I hope it proves useful.

Autofilter on a protected worksheet

You will quite probably have come across this problem already.  You need to protect the data in a worksheet for any number of reasons, but the recipient of the report wants to be able to use autofilter.
I've had this code for a while, but only recently needed it again, which reminded me to put it up here.

It's a very simple piece of code.  The code below applies a password to a worksheet, but leaves autofilter available.

   With Worksheets("YourWorkSheet")
      EnableAutoFilter = True
      Protect Password:="123", Contents:=True, UserInterfaceOnly:=True
   End With

As always, hope it proves useful.

Microsoft Excel 2010 and MSCOMCTL.OCX

Recently when working with Excel 2010 and certain userform controls some of my users have received the following error message:

"Component 'Mscomctl.ocx' or one of its dependencies not correctly registered: a file is missing or invalid"

Sometimes certain Microsoft Libraries can become unregistered when installing and uninstalling software. A common problem is the MSCOMCTL.OCX file.

If you receive the above error first search your drive for MSCOMCTL.OCX to see if you have the file. The file should be found in your C:\WINDOWS\SYSTEM directory or at C:\WINDOWS\SYSTEM32 if you are using Windows XP.  If the file is missing you can download it from: http://www.majorgeeks.com/files/mscomctl.zip.

Once it is there click START -> RUN and type "REGSVR32 MSCOMCTL.OCX" (without quotes) into the box to register this control.

You should find this fixes the problem.

Also relevant: http://support.microsoft.com/kb/2296116

Creating and reading data from text files

It is sometimes useful to keep data in a text file.  For example one of our clients has a resource file which has onOpen and onClose routines that log the current user, the date and time and whether the file was opened read/write or read only.

The code below shows how this can be done.

Sub Create_A_File()
' Put data into a text file
' This routine will create the file if it does not already exist

    Dim strMsg  As String
    Dim strFile As String

    strFile = ThisWorkbook.Path & "myFile.txt"
    ' could be .doc, .txt, .log etc

    strMsg = "Some text could go here"

    ' Open file for output - clears any current data
    'Open strFile For Output As #1
    ' or Open file for append - updates any current data
    Open strFile For Append As #1

    Print #1,                       ' Print blank line to file.
    Print #1, "*****"               ' Print ***** line to file.
    Print #1, strMsg                ' Print a variables value to the text file
    Print #1, Now, strMsg           ' Print date/time and the message, using commas create tab seperated data
    Print #1,                       ' Print another blank line to file.
    Print #1, Application.UserName  ' Print the current user's Excel username
    Print #1, Now                   ' Print the date and time

    Close #1                        ' Close file.

End Sub

Sub GetFromTxt()
' Copy data from one text file to another

    Dim FilePath    As String
    Dim File1       As String
    Dim File2       As String
    Dim File3       As String
    Dim FileData    As String

    Const FileExt   As String = ".txt"

    FilePath = "C:\File\Path\"
    File1 = "File Name 1"
    File2 = "File Name 2"
    File3 = "File Name 3"

    ' Example: FilePath & File1 & FileExt = "C:\File\Path\File Name 1.txt"

    'Open all relevant files
    Open FilePath & File1 & FileExt For Output As #1
    Open FilePath & File2 & FileExt For Input As #2
    Open FilePath & File3 & FileExt For Input As #3

    'Copy each line of the first existing file into the
    'new combined file
    Do While Not EOF(2)
        Input #2, FileData
        Print #1, FileData
    Loop

    'Copy each line of the second existing file into the
    'new combined file
    Do While Not EOF(3)
        Input #3, FileData
        Print #1, FileData
    Loop

    'Close all files
    Close #1
    Close #2
    Close #3
End Sub

Hope that proves useful.

Useful VBA file functions - Microsoft Scripting Runtime

Some example functions for finding out the last modified date of a file, copying a file and deleting a file using VBA.

Public Sub File_Last_Modified_Date()
' Use a function to return the last modified date of a file
    MsgBox f_File_Last_Modified_Date("C:\Put\the\full\file\address\here.xlsx")
End Sub

Private Function f_File_Last_Modified_Date(FileName As String) As String
' In the VBE, set a reference to Microsoft Scripting runtime
' Tools -> References... ->
    Dim fso As Scripting.FileSystemObject
    Dim fsof As Scripting.File
    Dim strPath As String

    Set fso = New FileSystemObject
    strPath = FileName
    Set fsof = fso.GetFile(strPath)
    With fsof
        f_File_Last_Modified_Date = .DateLastModified
    End With

    Set fso = Nothing
    Set fsof = Nothing
End Function

---

Public Sub CopyFile()
' Copy a file, the file cannot be open when the copy is attempted

    Dim SourceFile As String
    Dim DestFile As String

    SourceFile = "C:\Put\the\full\file\address\here.doc"
    DestFile = "C:\Put\the\new\file\address\here.doc"

    FileCopy SourceFile, DestFile
End Sub

Public Sub DeleteFile()
' Delete a file

    Dim FileName As String

    FileName = "C:\Put\the\full\file\address\here.txt"

    ' Check the file exists
    If Dir(FileName) = "" Then
        ' File does not exist
    Else
        ' Delete the file
        Kill FileName
    End If

End Sub

As always, any questions or comments please let us know via the comments section.

Application.Filesearch Replacement For Office 2007

If you have ever used completed a search for files using VBA you probably made use of Application.Filesearch.  However, if you’ve updated to Office 2007 or 2010 you may have noticed that Filesearch has been removed… but the (very) old Dir remains, so you can use this instead, an example of which follows:

Sub FileSearch()
    Dim fso As Object
    Dim FileName As String
    Dim strArr(1 To 65536, 1 To 1) As String
    Dim i As Long

    ' Set the directory / filename you are looking for
    Const strDir As String = "C:\Your\File\Path"
    Const SearchTerm As String = "YourFileNameTerm"

    ' Complete the search
    Let FileName = Dir$(strDir & "\*" & SearchTerm & "*.xls")
    Do While FileName <> vbNullString
        ' For each file found load to the array
        Let i = i + 1
        Let strArr(i, 1) = strDir & "\" & FileName
        Let FileName = Dir$()
    Loop

    ' Search within sub-folders
    Set fso = CreateObject("Scripting.FileSystemObject")
    Call RecurseSubFolders(fso.GetFolder(strDir), strArr(), i, SearchTerm)

    ' Tidy up and copy the results to the active worksheet
    Set fso = Nothing
    If i > 0 Then
        Range("A1").Resize(i).Value = strArr
    End If

End Sub

Private Sub RecurseSubFolders( _
    ByRef Folder As Object, _
    ByRef strArr() As String, _
    ByRef i As Long, _
    ByRef SearchTerm As String)

    Dim SubFolder As Object
    Dim FileName As String

    ' Search sub folders
    For Each SubFolder In Folder.SubFolders
        Let FileName = Dir$(SubFolder.Path & "\*" & SearchTerm & "*.xls")
        Do While FileName <> vbNullString
            Let i = i + 1
            Let strArr(i, 1) = SubFolder.Path & "\" & FileName
            Let FileName = Dir$()
        Loop
        Call RecurseSubFolders(SubFolder, strArr(), i, SearchTerm)
    Next
End Sub

“Code execution has been interrupted”

Every now and then, while executing macro routines within Excel you may get the error message “code execution has been interrupted”.  This error message should only appear if you hit “Ctrl+Break” to stop the execution and view the code. But… sometimes it just happens, normally with no apparent reason.

If you hit the “Continue” button, the code will execute for a while, and may even finish, but you may get the same error message again. Sometimes you may even have to click the “continue” button several times to complete the execution of a macro.

This issue caused intermittent problems for me over a long period of time, that was until I found the solution.

To stop this, often re-occurring, problem all you have to do is add one line of code “Application.EnableCancelKey = xlDisabled” as the first line of your macro.

This should fix the problem and enable you to execute your macro code successfully without getting the dreaded error message “Code execution has been interrupted” again.

The above fix is fine for any projects being rolled out to a group of users. If you’re testing code and using “Ctrl+Break” this might be a hindrance. Another fix is, while In the debug window, press Ctrl+Break, this again fixes the issue.

Of course, the next time you press “Ctrl+Break” in the Excel window the problem may well come back!

I say should because this is not guaranteed :( I have had occasions when this does not work, rebooting the PC is the only other possible solution I’ve found.

Compile Error: "Object Library Invalid..."

If you’ve ever come across the ‘Compile Error’ message you’ll know how much fun they can be to correct. 

Quite often when this message appears you’ll find yourself faced with the VBE telling you that ‘Left’ is not a valid function !  The first thing you should check is what references you are using.  If you’ve ever written some code on one version of Excel and tried to role it out to users with an older version you’ll have seen this many times. 

When you add references in an Excel 97 file and use it in Excel 2003 the references will automatically update.  If you try and do that the other way round the references do not ‘back-date’.  You’ll need to go to the references box and un-check the ‘Missing’ reference.  Then look through the list and find the older version which is available to the Excel version you are using.

The most recent one I found displayed the following message:

Object Library Invalid or Contains References to Object Definitions that could not be found.

I’ll add here that I was working in an office which predominately used Excel 97 with several PCs with Excel 2003.  A little retro there ;)

The error occurred in Excel 2003 using an Add-In (.xla) created in Excel 2003 !  I checked for missing references and found none.  The file opened and the code ran without issue on other machines, both Excel 97 and Excel 2003. 

After turning to Google I found this thread at ozgrid.com.  The answer; deleting the all the EXD files left by previous iterations of the project. EXD files cache ActiveX component information. If the component changes without removing the EXD file (which is created when the component is first used), then the system will be out of sync. 

To delete the EXD files go to command prompt and type the following DOS commands:

• > CD \Document and Settings
• > DEL /S /A:H /A:-H *.EXD

To explain what that does I’ll quote from the thread:

Essentially the command recursively deletes all your hidden and exposed exds. That will make all your ActiveX components load a bit slower the first time you use them again, but it should also clear out the problematic ones.

So, I’ll keep my fingers crossed that the above works for you too.

Using VBA to Convert a Column Number To A Letter

Sometimes while manipulating data in Excel you’ll have a integer which represents the column number, but need the column letter.

The function below can translate that number to the column letter required.  This function has been tested and works to 702, column ‘ZZ’.

Function ConvertToLetter(iCol As Integer) As String
'-----------------------------------------------------------------------------
' Procedure : ConvertToLetter
' Author    : Niall - Zypher.co.uk
' Purpose   : Convert a number to a column letter
'             Tested to 256 columns, assumed to work until 702 (ZZ)
'-----------------------------------------------------------------------------
'
    If iCol <= 26 Then
        ' Columns A-Z
        ConvertToLetter = Chr(iCol + 64)
    Else
        ConvertToLetter = Chr(Int((iCol - 1) / 26) + 64) & _
                          Chr(((iCol - 1) Mod 26) + 65)
    End If
End Function

As always, any questions or enquiries let us know via the comments section.

Add worksheets to Excel using VBA

Adding worksheets to Excel is quite simple. For example, to add a Worksheet before the active sheet (default unless stated otherwise), name it "MyWorksheet" and have it become the active sheet, you would use code similar to below;

Sub Add_New_Worksheet()
    ' Add a new worksheet in front of the active sheet
    Worksheets.Add().Name = "MyWorksheet"
End Sub

If we want to add a new Worksheet as the last Worksheet in the active workbook and name it "MyWorksheet" we would use;

Sub Add_As_Last_Worksheet()
    ' A a named worksheet to the end
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MyWorksheet"
End Sub

The Add Method (with regards to the Worksheet Object) has an After Variant as well as an Before Variant. You can only use one of the options, either the Before or After Variant, or omit the Argument altogether. If we do omit the Before and After Variants Excel places the Worksheet before the current active Sheet.

the example below shows how to add more then one Worksheet, the code below adds 2 new worksheets;

Sub Add_n_Worksheets()
    ' Insert 2 worksheets after the last current worksheet
    Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=2
End Sub

The last Variant available is the Type Variant. The Type specifies the sheet type. The choices available are listed below;
XlSheetType constants:

• xlWorksheet
• xlChart
• xlExcel4MacroSheet
• xlExcel4IntlMacroSheet

If you are inserting a sheet based on an existing template, specify the path to the template (Recording a macro is best for this). The default value is xlWorksheet.

Create a Microsoft Word Document with VBA

The below code is a basic example on how to create a Microsoft Word document.  This is sometimes useful if want to create a report showing your data outside of Excel.

Private Sub CreateWordDoc()
'-----------------------------------------------------------------------------
' Procedure : CreateWordDoc
' Author    : Matthew - Zypher.co.uk
' Date      : 12/04/2007
' Purpose   : Create a MS Word document using earling binding
'             Requires a reference to 'Microsoft Word ??.? Object Library'
'-----------------------------------------------------------------------------
'
    Dim objWord As Word.Application
    Dim doc As Word.Document

    'Create Word doc object
    Set objWord = CreateObject("Word.Application")

    With objWord
        ' Ensure the MS Word object is visible
        .Visible = True

        ' Add a new word document and save the file prior to adding text
        Set doc = .Documents.Add
        doc.SaveAs "C:\Your\File\Directory\Filename.doc(x)"

        ' Or open an existing document
        'Set doc = wrdApp.Documents.Open("C:\Foldername\Filename.doc")
    End With

    'Construct document
    With objWord.Selection
        ' Set the font type
        .Font.Name = "Trebuchet MS"
        ' Set the font size
        .Font.Size = 16

        ' Set the format, depending on the value of i
        For i = 1 To 50
            Select Case i
                Case Is < 10
                    ' Set the font size
                    .Font.Size = 12
                    ' Set font to bold
                    .Font.Bold = True
                    ' Align the text to the right of the page
                    .ParagraphFormat.Alignment = wdAlignParagraphRight

                Case Is < 20
                    ' Set the font size
                    .Font.Size = 8
                    ' Turn off bold
                    .Font.Bold = False
                    ' Align the text to the right of the page
                    .ParagraphFormat.Alignment = wdAlignParagraphLeft

                Case Is < 30
                    ' Set the font size
                    .Font.Size = 10
                    ' Turn on bold
                    .Font.Bold = True
                    ' Align the text to the right of the page
                    .ParagraphFormat.Alignment = wdAlignParagraphRight

                Case Is < 40
                    ' Set the font size
                    .Font.Size = 6
                    ' Turn off bold
                    .Font.Bold = False
                    ' Align the text to the center
                    .ParagraphFormat.Alignment = wdAlignParagraphCenter

                Case Else
                    ' do nothing
            End Select

            ' Add text
            .TypeText "Here is an example test line, #" & i _
                & " - Font size is " & .Font.Size
            ' Move to the next line
            .TypeParagraph

        Next i

    End With

    ' Save the file
    doc.Save
    ' Bring the MS Word window to the front
    doc.Activate

End Sub

As always, if you have any questions do let us know.

VBA Array Within An Array

When using VBA, writing anything but the most trivial VBA routines, it is likely that you’ll be using arrays somewhere in your code. This post describes how you can load one array to another and then pull the data out into a worksheet.
It is assumed that you know the basics of VBA arrays.
Sub ArrayWithinAnArray() 
'----------------------------------------------------------------------------
' Procedure : ArrayWithinAnArray
' Author    : Matthew - Zypher.co.uk
' Date      : 27/03/2011
' Purpose   : Load an ID, a data value and an array to an array
'             Then loop through the 1st array loading it’s values to the
'             active worksheet
'----------------------------------------------------------------------------
'     Dim i As Integer
    Dim l As Integer
    Dim x As Integer
    Dim y As Integer

    Dim array1(2, 2) As Variant
    Dim array2(1, 1) As Variant

    On Error GoTo ArrayWithinAnArray_Error

    ' Add values into the 1st array
    For i = 0 To 2
        array1(i, 0) = "ID " & i
        array1(i, 1) = "Some Data"

        ' Load values to the 2nd array
        array2(0, 0) = "row1 col1"
        array2(0, 1) = "row1 col2"
        array2(1, 0) = "row2 col1"
        array2(1, 1) = "row2 col2"

        ' Load the 2nd array into the 1st array
        array1(i, 2) = array2
    Next i

    ' Set l as the first row
    l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    ' Loop through the first array
    For i = 0 To UBound(array1)
        Cells(l, 1).Value = array1(i, 0)
        Cells(l, 2).Value = array1(i, 1)

        ' Check the 3rd value is an array
        If IsArray(array1(i, 2)) Then

            ' Loop down through the 2nd array
            For x = 0 To UBound(array1(i, 2))

                ' Loop across the 2nd array
                For y = 0 To UBound(array1(i, 2), 2)

                    ' Load the values in the 2nd array to the worksheet
                    Cells(l, y + 3).Value = array1(i, 2)(x, y)

                Next y

                ' Get the current bottom row, then add 1
                l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1
            Next x

        End If

        ' Get the current bottom row, then add 1
        l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    Next i

    On Error GoTo 0
    Exit Sub

ArrayWithinAnArray_Error:
    ' Add some error handling code here
End Sub
As always, if you have any questions do let us know via the comments section.

April Fools Reverse The Excel Menu with VBA

The code below will, when run, reverse all of the menus and their options within Excel.  For example; File will become Elif and Tools will become Sloot.  It works on Excel 97 through 2003.  Simply run the code again to ‘reverse’ the name back to their original format.  It is worth noting that Excel remembers the settings, so you will need to be able to re-run the code.

Sub ReverseMenuText()
    Dim m1 As CommandBarControl
    Dim m2 As CommandBarControl
    Dim m3 As CommandBarControl

    On Error Resume Next
    For Each m1 In Application.CommandBars(1).Controls
        m1.Caption = Reverse(m1.Caption)
        For Each m2 In m1.Controls
            m2.Caption = Reverse(m2.Caption)
            For Each m3 In m2.Controls
                m3.Caption = Reverse(m3.Caption)
            Next m3
        Next m2
    Next m1
End Sub


Function Reverse(MenuText As String) As String
    Dim Temp As String, Temp2 As String
    Dim ItemLen As Integer, i As Integer
    Dim HotKey As String * 1
    Dim Found As Boolean

    ItemLen = Len(MenuText)
    Temp = ""
    For i = ItemLen To 1 Step -1
        If Mid(MenuText, i, 1) = "&" Then _
            HotKey = Mid(MenuText, i + 1, 1) _
        Else Temp = Temp & Mid(MenuText, i, 1)
    Next i
    Temp = Application.Proper(Temp)
    Found = False
    Temp2 = ""
    For i = 1 To ItemLen - 1
        If UCase(Mid(Temp, i, 1)) = UCase(HotKey) And Not Found Then
            Temp2 = Temp2 & "&"
            Found = True
        End If
        Temp2 = Temp2 & Mid(Temp, i, 1)
    Next i
    If Left(Temp2, 3) = "..." Then Temp2 = Right(Temp2, ItemLen - 3) & "..."
    Reverse = Temp2
End Function

This code was orinally found on MrExcel.com.

Using VBA Speech

With April Fools day approaching (well, four weeks) I though I’d post a couple of amusing VBA tricks and jokes you could use.  The first is using the speech and the CD trey.  The code below can be copied straight into a VBA code module.

Declare Sub mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long)

Private Sub Workbook_Open()
    UseSpeech "The Mouse is hungry."
    OpenCDTray
    UseSpeech "Please add cheese."
    CloseCDTray
End Sub

Private Sub OpenCDTray()
    mciSendStringA "Set CDAudio Door Open", 0&, 0, 0
End Sub

Private Sub UseSpeech(stringToSpeak As String)
    Range("A1").Value = stringToSpeak
    Range("A1").Speak
    Application.CommandBars("Text To Speech").Visible = False
End Sub

Private Sub CloseCDTray()
    mciSendStringA "Set CDAudio Door Closed", 0&, 0, 0
End Sub

This does require the PC to have speakers.

VBA Version Property

It is sometimes useful to know which version of Excel your user is using.  An example of when this would be useful is knowing whether the user is in Excel 2007/2010 or and older version.  Excel 2007 was the first release that allowed over 65535 rows and 255 columns.  Excel 2007 has over 1 million rows (1048576) and 16384 columns.

This can make a big difference to what you can do with the data available to you.  If your user is in Excel 2003 for example your code could crash if it attempts to copy too much data into the active workbook.  The function below can be used within your code to confirm the Excel version, you can then call a different routine depending on it’s results.

Private Function ReturnExcelVersion() As String
'-----------------------------------------------------------------
' Procedure : ReturnExcelVersion
' Author    : Matthew - Zypher.co.uk
' Purpose   : return a string value denoting the version of Excel
'             Check the first two characters as Excel 97 has
'             several different releases and patches
'             http://support.microsoft.com/kb/232652
'-----------------------------------------------------------------
'
    Select Case Left(Application.Version, 2)

         Case Is = "14"
            ReturnExcelVersion = "2010" 
        Case Is = "12"
            ReturnExcelVersion = "2007"
        Case Is = "11"
            ReturnExcelVersion = "2003"
        Case Is = "10"
            ReturnExcelVersion = "2002"
        Case Is = "9."
            ReturnExcelVersion = "2000"
        Case Is = "8."
            ReturnExcelVersion = "97"
        Case Is = "7."
            ReturnExcelVersion = "95"
        Case Else
            ReturnExcelVersion = "Unknown"
    End Select
End Function

Excel 2010 is version 14. The version number 13 was skipped because of the aversion to the number 13.  Another relevant link is XL97: Overview and History of Excel Patches.

You may also want to look into Application.OperatingSystem.

As always, if you have any questions do let us know via the comments section.

Special Folders using the FileSystemObject

There are several methods to get find out the file paths for Microsoft Windows’ special folders (Systems folder, Temporary folder etc).  The example below uses the FileSystemObject.

Sub Special_Folders()
'-----------------------------------------------------------------
' Procedure : Special_Folders
' Purpose   : Retrieve file path for MS Windows 'special folders'
'             Requires a reference to Microsoft Scripting Runtime
'-----------------------------------------------------------------
'
    On Error GoTo ErrTrap

    Dim oFS As FileSystemObject

    Set oFS = New FileSystemObject

    ' Windows Folder Path
    MsgBox FS.GetSpecialFolder(WindowsFolder)

    ' System Folder - (example - Windows\System32)
    MsgBox oFS.GetSpecialFolder(SystemFolder)

    ' Temporary Folder Path
    MsgBox oFS.GetSpecialFolder(TemporaryFolder)

    If Not oFS Is Nothing Then Set oFS = Nothing

ErrTrap:
    Select Case Err.Number
        Case Is = 0
            ' No error continue
        Case Else
            MsgBox Err.Number & " - " & Err.Description
            Err.Clear
    End Select
End Sub

This routine requires a reference Microsoft Scripting Runtime.

Lotus Notes Email using VBA

The code I’m sharing with you today will enable you to send an email using VBA through  Lotus Notes.  It uses late binding so you do not need to use references to Lotus Notes, which in turn means you do not need to worry about your users Lotus Notes version.  I say this, though in practise this may not always be the case.  Lotus Notes is often rather frustrating, as many users will testify :)

As well as the subject and message body the routine allows you to specify the To, Cc and Bcc fields within a standard email format. 

The example below shows the code to attach a single file. This could easily be amended to loop through an array or collection of file addresses.

Sub SendAnEmailViaLotusNotes()

    Dim WS As Object
    Dim Session As Object
    Dim DB As Object
    Dim uiDB As Object
    Dim NotesAttach As Object
    Dim NotesDoc As Object
    Dim RichTextBody As Object
    Dim RichTextAttachment As Object
    Dim StyleBold As Object
    Dim StyleNorm As Object
    Dim StyleUnderline As Object
    Dim StyleFont10 As Object
    Dim Server As String
    Dim MailFile As String
    Dim TheUser As String
    Dim UserSig As String

    Dim strEmailTo As String        ' email To field
    Dim strEmailCc As String        ' email Cc field
    Dim strEmailBcc As String       ' email Bcc field
    Dim strEmailSbj As String       ' email Subject
    Dim strEmailBdy As String       ' email Body (message text)
    Dim strEmailAtt As String       ' email attachment

    Application.DisplayAlerts = False   ' turn off Excel alerts

    On Error GoTo ErrorMsg              ' on error goto ErrorMsg section...

' --- Set-up connection to Lotus Notes and Create Email object
    Set WS = CreateObject("Notes.NotesUIWorkspace")
    Set Session = CreateObject("Notes.NotesSession")

    TheUser = Session.UserName
    UserSig = Session.CommonUserName
    Server = Session.GetEnvironmentString("MailServer", True)
    MailFile = Session.GetEnvironmentString("MailFile", True)

    Set DB = Session.GetDatabase(Server, MailFile)
    Set uiDB = WS.CURRENTDATABASE
    Set NotesDoc = DB.CreateDocument

    Set RichTextBody = NotesDoc.CreateRichTextItem("Body")

' --- Set-up dist list, message and attachments
    strEmailTo = ""
    strEmailCc = ""
    strEmailBcc = ""
    strEmailSbj = ""
    strEmailBdy = ""
    strEmailAtt = ""

    NotesDoc.SendTo = strEmailTo        ' To...
    NotesDoc.CopyTo = strEmailCc        ' Cc...
    NotesDoc.BlindCopyTo = strEmailBcc  ' Bcc...
    NotesDoc.Subject = strEmailSbj      ' The subject
    NotesDoc.Body = strEmailBdy         ' Any text to be in the email

    ' Attach a file
    If strEmailAtt <> "" Then
        Set RichTextAttachment = NotesDoc.CreateRichTextItem("Attachment")
        Set NotesAttach = RichTextAttachment.EmbedObject(1454, "", strEmailAtt)
    End If

' --- Send the email / save the message in 'Sent' items
    ' False would not save the sent email to the sent items folder
    NotesDoc.SAVEMESSAGEONSEND = True
    ' Not sure why, but false send the eamil ?
    NotesDoc.SEND False

' --- Close connection to free memory
    Set Session = Nothing
    Set DB = Nothing
    Set NotesAttach = Nothing
    Set NotesDoc = Nothing
    Set WS = Nothing

    ' Turn on Excel alerts
    Application.DisplayAlerts = True

    Exit Sub

' --- if an error occurs display a message... then exit the macro
ErrorMsg:
    If Err.Number = 7225 Then
        MsgBox "The file " & strEmailAtt & " cannot be found in the specified location", vbOKOnly, "Error"
    Else
        MsgBox Err.Number & Err.Description
    End If

    Application.DisplayAlerts = True

End Sub

As always, if you have any questions do let us know via the comments section.

Access, Email, Excel, Lotus Notes, VBA

Using VBA to get a File’s Last Modified Date

It is sometimes useful to know the date and time a file was last modified.  this is particularly useful if you have a folder full of similar files and need to use the latest copy.

Today the code I’m going to share below enables you to pass a file address into a function which will return the date and time it was last saved.  The example below passes a file address to the function, which returns the modified date, this is then displayed in a message box.

The function requires a reference to Microsoft Scripting Runtime within the VBE.

Sub MyMacroRoutine()
    Dim ModDate As Date
    ModDate = FileLastModDate("C:\YourFileAddressGoesHere")
    MsgBox ModDate
End Sub

Function FileLastModDate(strFileAddress As String) As Date
' In the VBE, set a reference to Microsoft Scripting runtime

    Dim fso As Scripting.FileSystemObject
    Dim fsof As Scripting.File
    Dim strPath As String

    Set fso = New FileSystemObject
    strPath = strFileAddress
    Set fsof = fso.GetFile(strPath)
    With fsof
        FileLastModDate = .DateLastModified
    End With

    Set fso = Nothing
    Set fsof = Nothing

End Function

As always, if you have any questions do let us know via the comments section.