I am using an Excel 2013 file, which was updated by me to use PowerQuery for easier Data imports.
It already uses VBA Macros and i would like to include a Warning/MsgBox with a link to download PowerQuery, if it is not already installed.
How would i check for the existence of PowerQuery on the host System?
Adapting the code by Rory at the link i provided you would have something like the following. Note: You could use Rory's additional code to handle 2016 version or earlier ensuring if present is installed.
As you can't use a hyperlink direct i have adapted the Wiktor Stribiżew's code here that allows the user to click OK to go to the download site after getting msgbox saying not installed.
Option Explicit
Private Sub IsPowerQueryAvailable()
Dim downloadlink As String
downloadlink = "https://www.microsoft.com/en-gb/download/details.aspx?id=39379"
Dim bAvailable As Boolean
If Application.Version >= 16 Then
bAvailable = True
Else
On Error Resume Next
bAvailable = Application.COMAddIns("Microsoft.Mashup.Client.Excel").Connect
On Error GoTo 0
If Not bAvailable Then DownloadPowerQuery downloadlink
End If
End Sub
Private Sub DownloadPowerQuery(downloadlink As String)
Dim objShell As Object
Dim Message As String
Dim Wscript As Object
Set objShell = CreateObject("Wscript.Shell")
Message = MsgBox("Would you like to download PowerQuery?", vbYesNo, "Powerquery not available")
If Message = vbYes Then
objShell.Run (downloadlink)
Else
Wscript.Quit
End If
End Sub
Related
I want to deploy my addin with custom ribbon for a group of users.
To be able to auto update the tool for all my users i have created a Tool-Loader.dotm add-in. This add-in will be stored in the user C:\Users\xxx\AppData\Roaming\Microsoft\Word\STARTUP\ folder.
When the user is starting Word it should enable the real addin which is placed on a networkshare.
This way my users wont have to worry about updates because i only have to replace the read add-in on my networkshare. When the users restart Word is should reload the add-in and people are up to date.
I have added the following code to my Tool-Loader.dotm in STARTUP folder:
ThisDocument:
Option Explicit
Private Sub Document_New()
Dim addinpath As String
addinpath = "\\[NETWORK SHARE]\Tool.dotm"
If Dir(addinpath) <> "" Then
AddIns.Add FileName:=addinpath, Install:=True
Else
MsgBox "Cant load Tool. Please check network connection and VPN")
End If
End Sub
I did the same for :
Private Sub Document_Open()
It works fine when opening the Tool-Loader.dotm file directly. But it is not working when placing the file in the STARTUP folder and normally starting Word.
How can i fix thix problem?
Document_New and Document_Open only work for documents and document templates. A template placed in the Startup folder is termed a "global template" (Normal.dotm is also a global template). Global templates are loaded, not opened.
As there isn't an OnLoad event for a template we have to look for alternatives. If the global template contains a ribbon the ribbon's OnLoad event can be used. Otherwise we have to go old school and use an AutoExec routine, placed in a standard module.
Documentation for the Auto Macros can be found here
Public Sub AutoExec()
Dim addinpath As String
addinpath = "\\[NETWORK SHARE]\Tool.dotm"
If Dir(addinpath) <> "" Then
AddIns.add FileName:=addinpath, Install:=True
Else
MsgBox "Cant load Tool. Please check network connection and VPN"
End If
End Sub
Thank you! Based on your answer i am going to add a ribbon to my Tool-Loader and try to use the OnLoad event.
If that doesnt work i will try the AutoExec
Update for people having the same issue:
With the Custom UI Editor i added the following lines of code:
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="LoadAddin">
</customUI>
Then i opened the Tool-Loader.dotm file and placed the following code in ThisDocument:
Dim MyRibbon As IRibbonUI
Sub LoadAddin(Ribbon As IRibbonUI)
On Error Resume Next
Set MyRibbon = Ribbon
Dim addinpath As String
addinpath = "[networkshare]"
If Dir(addinpath, vbDirectory) = "" Then
MsgBox "Can't load addin, please check internetconnection and VPN."
Exit Sub
Else
AddIns.Add FileName:=addinpath & "Tool.dotm", Install:=True
End If
End Sub
Now it works and when opening Word the latest version of the tool is loaded.
I too use a tool loader to deploy a network shared dotm. I keep my Ribbon in the main file though, not in the tool loader.
I make sure the user has their wdWorkgroupTemplatesPath set to the network location where the main addin is kept. The tooloader then uses autoexec to call the below Addin-loader, if it doesn't find the Addin in word's list of addins it falls back to loading it from the file on the network drive.
Public Sub AutoExec()
Call LoadAddin
End Sub
Public Sub LoadAddin()
Dim vAddin As Variant
Dim bLoaded As Boolean
Dim strWorkgoupTemplatesPath As String
bLoaded = False
On Error GoTo ErrorHandler
For Each vAddin In Application.AddIns
If ADDINNAME = vAddin.Name Then
Application.DisplayAlerts = False
vAddin.Installed = True
bLoaded = True
Application.DisplayAlerts = True
End If
Next vAddin
LoadFromFile:
If Not bLoaded Then
strWorkgoupTemplatesPath = Options.DefaultFilePath(Path:=wdWorkgroupTemplatesPath)
Call InstallMainAddin(strWorkgoupTemplatesPath)
End If
ExitHandler:
Exit Sub
ErrorHandler:
bLoaded = False
If Err.Number = 4706 Then GoTo LoadFromFile
GoTo ExitHandler
End Sub
Function InstallMainAddin(strWorkgoupTemplatesPath As String) As Boolean
Dim bResult As Boolean
Dim vMainAddin As Variant
On Error Resume Next
SetAttr strWorkgoupTemplatesPath & ADDINNAME, vbReadOnly
On Error GoTo ErrorHandler
Application.DisplayAlerts = False
Set vMainAddin = Application.AddIns.Add(strWorkgoupTemplatesPath & ADDINNAME)
vMainAddin.Installed = True
bResult = True
ExitHandler:
Application.DisplayAlerts = True
InstallMainAddin = bResult
Exit Function
ErrorHandler:
bResult = False
GoTo ExitHandler
End Function
Can I delete an Outlook VBA Module?
I have tried the below code:
Dim vbMod As Object
Set vbMod = Application.VBE.ActiveVBProject.VBComponents
vbMod.Remove VBComponent:=vbMod.Item("Module2")
But getting an error:
438 Error, Object doesn't support this property or method
Can this be done with Outlook VBA and are there any References to be included?
Try this.
You will need to add a reference to Microsoft Visual Basic for Applications Extensibility 5.3.
Public Sub DeleteModule(ByVal ModuleName As String)
On Error GoTo Trap
Dim VBAEditor As VBIDE.VBE
Dim objProject As VBIDE.VBProject
Dim objComponent As VBIDE.VBComponent
Set VBAEditor = Application.VBE
Set objProject = VBAEditor.ActiveVBProject
For Each objComponent In objProject.VBComponents
If objComponent.Name = ModuleName Then
objComponent.Collection.Remove objComponent
End If
Next
Leave:
On Error GoTo 0
Exit Sub
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
To test it:
Sub Test()
DeleteModule "ModuleName"
End Sub
The answer to your answer is no, we can't delete or even access programmatically the VBIDE; it is correct that you can add reference to Microsoft Visual Basic for Applications Extensibility 5.3, but to no avail.
If you try this at Word or Excel, this is the output:
But, when you try this at Outlook, VBE is not exposed:
Here is a confirmation. Maybe in older Outlook versions, less safer, you could do that, but at least since Outlook 2002, it is not possible.
this is an example sub to programatically install a type library for API. Why is the error handling routine failing? I attempted to follow the try...except...finally strategy I am familiar with from Python.
Sub CopyViewLayout():
'TRY:
On Error GoTo addReference
Dim App As femap.model
'COMPILE ERROR: USER TYPE NOT DEFINED
ResumeSub:
Dim App As femap.model
Set App = GetObject(, "femap.model")
Dim rc As Variant
Dim feView As femap.View
Set feView = App.feView
rc = feView.Get(0)
Exit Sub
'EXCEPT:
addReference:
Dim vbaEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim checkRef As VBIDE.Reference
Dim filepath As String
Set vbaEditor = Application.VBE
Set vbProj = ActiveWorkbook.VBProject
filepath = "C:\apps\FEMAPv11\"
On Error GoTo Failure
vbProj.References.AddFromFile (filepath & "femap.tlb")
Set vbProj = Nothing
Set vbaEditor = Nothing
GoTo ResumeSub
'FINALLY
Failure:
MsgBox ("couldn't find type library, exiting sub")
End Sub
EDIT
I broke out this section from main because Error handling is just ridiculous in VBA... A better approach for me was to implement a finite-state-machine using Booleans.
answer
Sub refcheck()
Dim i As Long
Dim FEMAP_GUID As String
FEMAP_GUID = "{08F336B3-E668-11D4-9441-001083FFF11C}"
With ActiveWorkbook.VBProject.references
For i = 1 To .Count
If .Item(i).GUID = FEMAP_GUID Then
Exit For
Else
'note: filepath is determined using Dir() elsewhere...
.AddFromFile (filepath & "femap.tlb")
Exit For
End If
Next
End With
End Sub
Error handling only handles runtime errors; not compile time errors. Use
Dim App as Object
And make sure you only Dim App once in your code.
By using As Object, you can late bind any object to it. You lose Intellisense while youre coding thought.
Like Dick mentioned, use Late Binding but that alone is not enough. You will have to use it with proper Error Handling.
For example
Dim App As Object
On Error Resume Next
Set App = GetObject(, "femap.model")
On Error GoTo 0
If App Is Nothing Then
MsgBox "Please check if femap is installed"
Exit Sub
End If
'
'~~> Rest of the code
'
If you are sure that it is installed then you are getting the error because the relevant library is not referenced. For that I would recommend having a look at How to add a reference programmatically
I would however still suggest that you take the Late Binding route.
I am trying to prompt the user when he tries to close a workbook like this
Private Sub Workbook_BeforeClose(Cancel as Boolean)
MsgBox "Changes has been detected. Do you want to export the data ?"
End Sub
I know that this code need to be placed in ThisWorkbook module.
Is there a way to do that from my custom module ? I need to add this functionality to multiple workbooks used by my client as a part of up-gradation, which is usually done by replacing old modules with new modules.
You can use the Application.VBE object and Workbook.VBProject to modify a file's VBA. Note however that it requires that the Excel performing the upgrade has to have the setting "Trust access to the VBA project" toggled on (it can be found in the Trust center under the tab Macro settings). When not needed anymore, it's an option best left off though for security reasons.
There is a way how you can Import the ThisWorkbook Module. I wrote some Code for that a long Time ago.
So how does it work.
First you have to Export the ThisWorkbook Module. Right click on the Module and Export.
Save the ThisWorkbook.cls on the Server where you have your other Module's or send it with the Modules (Like how you do the Upgrade of the other Modules)
Open the ThisWorkbook.cls File with a Editor (Like Notepad++)
And Delete The First Rows. They Look like This.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Execute the UpdateThisDocument Subrutine.
The Only Question how have to answer yourself is how you will Execute The Code ^^ (I wrote en Extern Updater that Executed the Code)
Sub UpdateThisDocument()
Dim ModuleName As String
ModuleName = "DieseArbeitsmappe"
Dim aDoc As Workbook
Set aDoc = ThisWorkbook
Dim strPath As String
'Put here the Path to the Folder where the cls File of This Workbook is.
strPath = "C:\Users\z002mkvy\Desktop\"
With aDoc
If ModuleExists(ModuleName) = True Then
Call clsLoeschen
End If
'
With ThisWorkbook.VBProject
.VBComponents(ModuleName).CodeModule.AddFromFile _
strPath & "\DieseArbeitsmappe.cls"
Fehler:
End With
End With
End Sub
Private Function ModuleExists(ModuleName As String) _
As Boolean
On Error Resume Next
ModuleExists = Len(ThisWorkbook.VBProject _
.VBComponents(ModuleName).Name) <> 0
End Function
Private Sub clsLoeschen()
Dim modcls
Dim awcl As Integer
On Error Resume Next
Set modcls = ThisWorkbook.VBProject.VBComponents.Item("DieseArbeitsmappe")
awcl = modcls.CodeModule.CountOfLines
modcls.CodeModule.DeleteLines 1, awcl
Set modcls = Nothing
End Sub
I hope This can Help you
I have a module that will automate Outlook but it should be skipped if Outlook isn't available.
Simply checking whether Outlook is installed is not sufficient because if there is a fresh Office install, launching Outlook will simply launch the configuration wizard. From my POV, Outlook is not available for automation so the module shouldn't be used even though it might be installed.
From my tests and the suggestions in this question, I can successfully trap for whether Outlook isn't configured yet but there is an edge case where this fails. This is when there is a dialog that asks to select a profile. In this situation, the check returns true but Outlook is actually not usable for the purposes of automation due to still needing additional configuration (e.g. selecting a profile). Is it possible to also trap this edge case?
To reproduce the "Select Profile" issue, go to Control Panel -> Mail. On the dialog, there is a option to "When starting Microsoft Outlook, use this profile" - select "Prompt for a profile used". When you then launch Outlook, you are asked to choose a profile. That is the case when the code below will fail.
This is my almost-working code so far...
Public Function DetectOutlookProfile() As Boolean
Dim objOutlook As Object
Dim objReg As Object
Dim varSplit As Variant
Dim lngMajor As Long
Dim strPath As String
Dim varSubKeys As Variant
Dim varSubKey As Variant
Const HKEY_CURRENT_USER As Long = &H80000001
On Error GoTo ErrHandler
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
'Get an instance of Outlook so that we can determine the version
'being currently used by the current user.
Set objOutlook = CreateObject("Outlook.Application")
varSplit = Split(objOutlook.Version, ".")
lngMajor = varSplit(0)
If lngMajor <= 14 Then
'Outlook profile isn't version specific for Outlook 97-2010
strPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Else
'Outlook profile is version specific for Outlook 2013+
strPath = "Software\Microsoft\Office\" & lngMajor & ".0\Outlook\Profiles"
End If
objReg.EnumKey HKEY_CURRENT_USER, strPath, varSubKeys
For Each varSubKey In varSubKeys
DetectOutlookProfile = True
Exit For
Next
ExitProc:
On Error Resume Next
Exit Function
ErrHandler:
'Silently fail and return false
Select Case Err.Number
Case Else
DetectOutlookProfile = False
Debug.Print Err.Number & " (" & Err.Description & ")"
End Select
Resume ExitProc
Resume
End Function
Thanks to #David Zemens' suggestions, I found a solution that seems to work.
It seems that I don't even need to bother with registry checks. I can simply do this instead:
Set objOutlook = CreateObject("Outlook.Application")
DetectOutlookProfile = Len(objOutlook.GetNamespace("MAPI").CurrentProfileName)
Which will return 0 whether the Outlook has no profiles or is requiring a manual profile selection.
I suppose the registry check is needed to determine whether the Outlook has any profiles configured so that one's code could be then written to manually prompt the user for profile to be passed into Login method. For my case, I just don't want to run the module in either case, so the checking Len() of the current profile name suffices.