VBA - Visual Basic for Applications

Here we have two more functions, which have done me great service over the last years.

Instead of duplicating the code for switching on and off certain Excel application specific events, alerts and so on you can call these two functions before and after each function call reachable through an user interface.

Version & Remarks

Version Date Description
0.2 2015-02-01 Now preventing user interaction / input with Excel through keyboard or mouse.

 

2015-02-01

I've written a script to postprocess some data extracted from a database for one of my clients. Processing took quite some time and a collegue came up to me showing me on my keyboard how his wife typed in something wrong. Great! the script was only half way through and stopped, now showing my collegues input in a cell in one of the referenced Excel workbooks. Luckily I had a log file and could continue from there.

Lessons learned - prevent a user from interacting with Excel while you are processing something in VBA. Below a reference from the according Microsoft documentation for the Interactive property of the Excel Application object. Before I made this experience I always thought that this would happen automatically.

"If you set the this property to False, Microsoft Excel will block all input from the keyboard and mouse (except input to dialog boxes that are displayed by your code). Read/write Boolean."

However you will still be able to interrupt code exceution pressing the escaoe button.

Source Code

Make sure to place the function call of switchOnApp always after an error handling in the top calling function. Do not place calls to below functions in any function, which is called by other functions / subs. Else you would end up disabling and enabling application properties, when you actually don't want to enable or disable them.

'@Author - Alexander Bolte
'@ChangeDate - 2014-05-30
'@Description - Switches on all events, automated claculation and alerts in Excel. Also switches security to standard in Excel Security Center.
Public Sub switchOnApp()
' reset security settings
Application.AutomationSecurity = msoAutomationSecurityByUI
Application.EnableEvents = True
Application.DisplayAlerts = True
If Not (ActiveSheet Is Nothing) Then
Application.Calculation = xlAutomatic
End If
Application.ScreenUpdating = True
Application.EnableAnimations = True
Application.Interactive = True
End Sub

'@Author - Alexander Bolte
'@ChangeDate - 2014-05-30
'@Description - Switches off all events, automated claculation and alerts in Excel. Also switches security to low in Excel Security Center in case macro enabled workbooks have to be processed.
Public Sub switchOffApp()
' Disable all alerts.
Application.DisplayAlerts = False
' Disable all event handling.
Application.EnableEvents = False
' Enable macros on workbooks opened through automation.
Application.AutomationSecurity = msoAutomationSecurityLow
' Disable automated calculation.
If Not (ActiveSheet Is Nothing) Then
Application.Calculation = xlManual
End If
Application.EnableAnimations = False
Application.ScreenUpdating = False
Application.Interactive = False
End Sub

Referenced API

Important referenced APIs are listed below.

Whenever you have a list of unique key values identifying one file in a directory, but the file name contains other text as well it is possible to use wildcards in order to open the file you want.

Below code snippet will do the trick for you.

Source Code

The function Dir() returns an empty String (""), in case a file could not be identified. Therefore you will need extra handling for this case.

In case more than one file was identified by Dir(), only the first file (whichever the first may be) is returned.

1
2
3
4
5
6
Dim sFound As String
 
sFound = Dir(ActiveWorkbook.Path & "\302113*.xlsm")    'the first one found
If sFound <> "" Then
    Workbooks.Open filename:= ActiveWorkbook.Path & "\" & sFound
End If
 

Ever since I am working in roles providing technical support for Identity and Access Governance, I am often confronted with the need of printing and archiving a lot of mails for audit trail.

I do despite this task not only because it is annoying but also because there are much better ways for documenting audit proof history than using a document based system.

Anyway ... Since this task is annoying I wrote a little script in VBA to print all selected emails.

Source Code

This will go into a class called PdfPrinter. It utilizes MS Word in order to print /convert emails to PDF.

Utilizing MS Word is not the best option since the other Application has to be handled properly in order to close Word properly after the job is done. Else you are facing lost references and the application stays open in RAM and the user does not even see it is still running.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Explicit
 
Sub SaveMessageAsPDF()
    Dim tmpFileName As Variant
    Dim MyDocs As Variant
    Dim Selection As Selection
    Dim obj As Object
    Dim Item As MailItem
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    
    Set wrdApp = CreateObject("Word.Application")
    Set Selection = Application.ActiveExplorer.Selection
 
    For Each obj In Selection
       Set Item = obj
       Dim FSO As Object
       Dim TmpFolder As Object
       Dim sName As String
       Set FSO = CreateObject("Scripting.FileSystemObject")
       Set tmpFileName = FSO.GetSpecialFolder(2)
       
       sName = Item.Subject
       sName = replaceCharsForFileName(sName, "_") & Format(Now, "hh_mm_ss")
       tmpFileName = tmpFileName & "\" & sName & ".mht"
       
       Item.SaveAs tmpFileName, olMHTML
       Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=True)
       
       Dim WshShell As Object
       Dim SpecialPath As String
       Dim strToSaveAs As String
       Set WshShell = CreateObject("WScript.Shell")
       MyDocs = WshShell.SpecialFolders(16)
          
       strToSaveAs = MyDocs & "\" & sName & ".pdf"
    
       ' check for duplicate filenames
       ' if matched, add the current time to the file name
       If FSO.FileExists(strToSaveAs) Then
          sName = sName & Format(Now, "hhmmss")
          strToSaveAs = MyDocs & "\" & sName & ".pdf"
       End If
     
       wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
            strToSaveAs, _
            ExportFormat:=wdExportFormatPDF, _
            OpenAfterExport:=False, _
            OptimizeFor:=wdExportOptimizeForPrint, _
            Range:=wdExportAllDocument, _
            From:=0, To:=0, Item:= _
            wdExportDocumentContent, _
            IncludeDocProps:=True, _
            KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, _
            DocStructureTags:=True, _
            BitmapMissingFonts:=True, _
            UseISO19005_1:=False
    Next obj
    
    wrdDoc.Close
    wrdApp.Quit
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
    Set WshShell = Nothing
    Set obj = Nothing
    Set Selection = Nothing
    Set Item = Nothing
End Sub
 
' This function removes invalid and other characters from file names.
Private Function replaceCharsForFileName(ByVal sName As String, sChr As String) As String
    sName = Replace(sName, "/", sChr)
    sName = Replace(sName, "\", sChr)
    sName = Replace(sName, ":", sChr)
    sName = Replace(sName, "?", sChr)
    sName = Replace(sName, Chr(34), sChr)
    sName = Replace(sName, "<", sChr)
    sName = Replace(sName, ">", sChr)
    sName = Replace(sName, "|", sChr)
    sName = Replace(sName, "&", sChr)
    sName = Replace(sName, "%", sChr)
    sName = Replace(sName, "*", sChr)
    sName = Replace(sName, " ", sChr)
    sName = Replace(sName, "{", sChr)
    sName = Replace(sName, "[", sChr)
    sName = Replace(sName, "]", sChr)
    sName = Replace(sName, "}", sChr)
    sName = Replace(sName, "!", sChr)
    
    replaceCharsForFileName = sName
End Function

 

Subcategories

This category will hold articles regarding developement in Excel VBA. It will serve as a wiki and an Excel VBA Framework for myself.

Some development tasks reoccur for every customer. Since I am a lazy bum it will be nice to have a central source where I can reuse source code from.

This category holds articles regarding general things in MS Office VBA independent from the MS Office application.  

This category holds articles regarding Access VBA, but also general things I come accross Access and its usage in companies.