I am doing a user application that needs an AddIn which I want to update in the workbook_open event.
Here is my plan:
Add Reference to "Microsoft Visual Basic for Applications Extensibility 5.3"
Delete Reference to old AddIn
Delete old AddIn if existing
Copy AddIn from different Folder
Add Reference to new AddIn
This should be done all while the vbProject is password protected and hidden. Here is my code:
Private Sub Workbook_Open()
Dim wb As Workbook
Set wb = Thisworkbook
'
If common_DB.AddFSOref(wb) Then Debug.Print "Added Extensibility"
If common_DB.AddRegEx(wb) Then Debug.Print "Added Regular Expressions"
UpdateDBAddin
End Sub
That is my update code that works without password protection but when adding in the reference in the vbProject password is required. I want to suppress that because my users do not have to worry about that.
Public Sub UpdateDBAddin()
Dim UserPath As String
Dim AI As AddIn
Dim AddinSourcePath As String
Dim AddinName As String
Dim Addintitle As String
Dim RefName As String
Dim ref As Reference
RefName = "Ex_Ample_Name"
AddinName = "ExampleName.xlam"
Addintitle = "Example AddIn"
UserPath = Application.UserLibraryPath
AddinSourcePath = "E:\Xample\Path\"
Application.DisplayAlerts = False
For Each ref In Thisworkbook.VBProject.References
If ref.Name = RefName Then
Thisworkbook.VBProject.References.remove ref
End If
Next ref
If Application.AddIns(Addintitle).IsOpen Then
Workbooks(AddinName).Close False
End If
If common_DB.IsFile(UserPath & "\" & AddinName) Then
Application.AddIns(Addintitle).Installed = False
Kill (UserPath & "\" & AddinName)
End If
Application.AddIns.Add (AddinSourcePath & AddinName)
Application.AddIns(Addintitle).Installed = True
Application.DisplayAlerts = True
' Here the VBProject Password is requested from the user, I want to suppress that
Thisworkbook.VBProject.References.AddFromFile (UserPath & "\" & AddinName)
End Sub
Question: How do I suppress the password when I want to add a new reference to my Vbproject?
EDIT1: Dilemma because it only occures when the project is hidden and I cannot 'debug' in the hold-mode. I narrowed the issue down to the adding of the reference to the addin on the last line of UpdateAddin.
EDIT2: This has some funnny behaviour. If you just Cancel the password prompt it works just fine. So the reference gets added. It doesn't matter if you put in the password or if you just cancle it the line gets executed.
So far I do not have a solution, but I found the workaround.
Just leave user to cancel password for a first time.
Reference will be added from file.
Then force the main xlsm to be Saved (can't be opened as ReadOnly)
Upon next run, check if correct reference with correct name and path is already referenced. if yes skip adding reference from file .. no password popup.
Anyway I am still looking for a solution how to avoid the first popup. Especially because our users are opening main XLSM in ReadOnly mode ..
Related
I have a workbook that is password protected and I’d like to create a read only copy that other users can view on a different location on the network drive.
I know it’s a strange request as the other people could open the original as read only, but we don’t want them to know the location of the original or have anything to do with it, should they figure out my colleagues password.
The other issue we had was that people were opening as read only and it was still telling my colleague that it was locked by another user and he needs it for most of the day so that issue is annoying
Thanks in advance
What you could do is add the following event procedure to the ThisWorkbook module:
Const RemotePath As String = "D:\YourRemoteLocation\"
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error GoTo CleanUp
If Success And InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
Dim CopyFullName As String
CopyFullName = RemotePath & "Copy of " & ThisWorkbook.Name
Application.EnableEvents = False
Dim fso As FileSystemObject 'Requires the Microsoft Scripting Runtime Library
Set fso = New FileSystemObject
fso.CopyFile Source:=ThisWorkbook.FullName, Destination:=CopyFullName
Dim ReadOnlyWorkbook As Workbook
Set ReadOnlyWorkbook = Workbooks.Open(Filename:=CopyFullName)
Application.DisplayAlerts = False
ReadOnlyWorkbook.SaveAs Filename:=CopyFullName, Password:=""
Application.DisplayAlerts = True
ReadOnlyWorkbook.Close SaveChanges:=False
End If
CleanUp:
Application.EnableEvents = True
Application.DisplayAlerts = True
Set fso = Nothing
End Sub
This code will run every time the workbook is saved and export the current file to the remote location. Then it will open the copy and save it as a workbook without password.
Note that I've added InStr(ThisWorkbook.Name, "Copy of ") = 0 as a condition to the If-statement. Instr returns the position where a substring (arg2) appears in the main string (arg1) or zero if the substring is absent from the main string. In this context, we want it to be zero since we don't want to run the code in the workbook copy.
In this method, the owner of the original file will have to supply their password every time they save. You could automate this by passing the password as an argument to the Open method like this:
Set ReadOnlyWorkbook = Workbooks.Open( _
Filename:=CopyFullName, _
Password:="MyPassword")
However, the password would then be accessible by people looking into the VBA code.
Alternatively you could get the password from a local file that wouldn't be accessible from the Network, but then the file path would be visible.
And if the remote folder is not already set to be Read-only mode, you can make sure that people opening the remote version of the file do so in Read-Only mode by adding the following event procedure after the previous one.
Private Sub Workbook_Open()
If InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
End If
End Sub
Obviously this will only work if they enable macros.
I have two Excel files, parent and child, where child contains a library of functions used by parent's functions. For versioning purposes I keep them in the same folder and copy and rename the folder in exactly the same location to keep track of my versions. I also want the references to be dynamically updated so that when i move to a new version, parent always points to child in the same location.
So in order to accomplish this I have implemented two routines in parent.
One, is in ThisWorkbook I used Workbook_Open sub:
Private Sub Workbook_Open()
'Force the location of the shared library to the current project folder irrespective where the project is located
Call reloadSharedLibrary
End Sub
Two, in Modules.Libraries I added another sub reloadSharedLibrary:
Public librName As Variant
Public isRefReloaded As Boolean
Sub reloadSharedLibrary()
isRefReloaded = True
Dim VBAEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim chkRef As VBIDE.Reference
Dim BoolExists As Boolean
Dim librPath As String
Set VBAEditor = Application.VBE
Set vbProj = ActiveWorkbook.VBProject
librName = "lib_emtm"
librPath = Application.ActiveWorkbook.Path & "\lib.xlsm"
' delete any shared lib (if exists)
For Each chkRef In vbProj.References
If chkRef.Name = librName Then
vbProj.References.Remove chkRef
BoolExists = True
End If
Next
' you can only add it to VBAProject only after you quit the above loop
On Error Resume Next
vbProj.References.AddFromFile librPath
If Err.Number <> 0 Then
MsgBox "FATAR ERROR: Cannot find shared library file in project root": End
End If
Set vbProj = Nothing
Set VBAEditor = Nothing
End Sub
Now, the problem with this is that when I copy the project folder to a new version folder the reference to child does not get updated. The child the version uses is from the old version.
What am I doing wrong?
The problem is that when the VBA project loads a document and its references, it assigns them a name, which is lib_emtm in your case. When you uncheck the reference to it, the reference is removed from the VBA project but the project editor will keep the name in its cache. This name will remain in the cache until you close the workbook and reopen it.
You can verify this in the project references menu: you will see that even if you uncheck the reference, the name of the library lib_emtm will still appear there.
Then when you try to add a reference to the "other" child workbook (the one in the same folder), the editor will find that the name is lib_emtm which is the same as the one in the cache, so instead of opening the new document and parsing it, it will use the cached version, which is the old one!
If you close then re-open the application, the name of the library will disappear from the cache, so you can install the correct version. To be complete, this pattern occurs only with references to other workbooks, not with regular DLL's installed on the system.
I tried but couldn't find a VBA way to remove the Cached library from the editor's cache before re-installing it. If someone finds a way it would complete the solution. Therefore at the moment we must close the document before re-opening it and installing the lib. This process might be automated but I suggest a solution that prompts the user for that.
' Module ThisWorkbook
Option Explicit
Private Sub Workbook_Open()
'Force the location of the shared library to the current project folder irrespective where the project is located
Dim check As Boolean: check = checkSharedLibrary
If check Then Exit Sub
Dim prompt
prompt = MsgBox("The installed lib_emtm library was uninstalled because it was not the correct version." & vbCrLf & _
"If you click Ok, document will close and the correct version will be automatically installed when you reopen it." & vbCrLf & _
"If you click Cancel, library will not be available in this session but will be installed next time you open the document", vbOKCancel)
If prompt = vbOK Then ThisWorkbook.Close True
End Sub
' Regular module
Option Explicit
Private librName As String, librpath As String
' if correct version already installed (correct path) return true
' if library installed with incorrect version, uninstall it and return false
' if library not installed, install it and return true
Public Function checkSharedLibrary() As Boolean
librName = "lib_emtm"
librpath = ThisWorkbook.Path & "\lib_emtm.xlsm"
Dim chkRef As VBIDE.Reference
For Each chkRef In ThisWorkbook.VBProject.References
If chkRef.name = librName Then Exit For
Next
If chkRef Is Nothing Then
install_emtm
checkSharedLibrary = True
ElseIf Left(chkRef.FullPath, InStrRev(chkRef.FullPath, "\") - 1) = ThisWorkbook.Path Then
checkSharedLibrary = True ' we have the correct version
Else
ThisWorkbook.VBProject.References.Remove chkRef ' return false
End If
End Function
Private Sub install_emtm()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile(librpath)
If Err.Number <> 0 Then MsgBox "FATAR ERROR: Could not install lib_emtm:" & vbCrLf & Err.Description & vbCrLf & vbCrLf & _
"Please verify that the library's file is present in the same folder or try a manual install"
End Sub
A final remark, the process can be automated without user intervention if we close directly the application but before that we can schedule the re-opening of the workbook . But things might get complicated because the user may have other Excel documents open, so we cannot oblige her to close everything.
I have a macro in workbook ABC. I want to find out what other workbooks are calling this macro, since we are going to be replacing its functionality. Is there a way to tell what workbook is calling the macro when it executes? Or does Application.Run hide that from the called macro?
I'm not sure how to get the workbook name. You could log the workstation and user, then go to the workstation and start Excel and go to File -> Recent to see the recent workbooks used on the computer.
You can write a log file to the location where the workbook is that contains the macro.
Something like this called from the macro.
In you VBA IDE go to the tools menu and select references. Select "Microsoft scripting runtime"
Private Sub LogUsage()
Dim ts As TextStream
Dim fs As FileSystemObject
Dim strLogFile As String
strLogFile = Application.ActiveWorkbook.Path & "\Usage.txt"
'Check if the file exists, if it does, open it, if it doesn't create it
Set fs = New FileSystemObject
If fs.FileExists(strLogFile) = True Then
Set ts = fs.OpenTextFile(strLogFile, ForAppending)
Else
Set ts = fs.CreateTextFile(strLogFile, True, False)
End If
'Log your entry
ts.WriteLine "Used by " & Environ$("Username") & " at " & Now & " on computer " & Environ$("Computername")
'Clean up
ts.Close: Set ts = Nothing
Set fs = Nothing
End Sub
I need some way to update an excel addin shared among my staffs so as everyone don't have to download & install it manually.
I have googled and see that we can write file to the OS file system so the task ends up with writing the new-version addin, i.e. the .xlam file, to overwrite itself.
I have no idea on how to do this. If you do have ones, please share! Thank you!
I don't know if there's a less crude way of doing it, but I have "hacked" a solution that involves SendKeys. Yuck, I know. Hopefully someone else will have a better solution.
As I recall, you need to uninstall an addin before you can overwrite the .xla(m) file and I couldn't find a way to do this purely using built-in objects.
The code below basically uninstalls the add-in, invokes the "Add-ins" dialog box and uses SendKeys to remove it from the list, before copying the new file and reinstalling the add-in.
Amend it for your circumstances - it will depend on your users having their security settings low enough to let it run, of course.
Sub UpdateAddIn()
Dim fs As Object
Dim Profile As String
If Workbooks.Count = 0 Then Workbooks.Add
Profile = Environ("userprofile")
Set fs = CreateObject("Scripting.FileSystemObject")
AddIns("MyAddIn").Installed = False
Call ClearAddinList
fs.CopyFile "\\SourceOfLatestAddIn\MyAddIn.xla", Profile & "\Application Data\Microsoft\AddIns\", True
AddIns.Add Profile & "\Application Data\Microsoft\AddIns\MyAddIn.xla"
AddIns("MyAddIn").Installed = True
End Sub
Sub ClearAddinList()
Dim MyCount As Long
Dim GoUpandDown As String
'Turn display alerts off so user is not prompted to remove Addin from list
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do
'Get Count of all AddIns
MyCount = Application.AddIns.Count
'Create string for SendKeys that will move up & down AddIn Manager List
'Any invalid AddIn listed will be removed
GoUpandDown = "{Up " & MyCount & "}{DOWN " & MyCount & "}"
Application.SendKeys GoUpandDown & "~", False
Application.Dialogs(xlDialogAddinManager).Show
Loop While MyCount <> Application.AddIns.Count
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I use a reversioning addin-manager to do this: basically its a small xla/xlam that never changes thats installed on each users machine. It checks a network share for the latest version of the real addin(s) and opens it as if it was an ordinary workbook: this has the effect of loading the real Addin(s) for the user.
There is a downloadable working example which you can customise here
Another option, this is what I do.
Key points.
Addin version is "some number", file name is always the same.
Installation directory must be known
When asked, the current addin, looks to see if a new version is available. I do this via a system that has a version number in the file name of the "update" and a version number as a const in the code.
Having established I we can update, I go and get the update "package" - in my case I am using an installer and a small vb.net app. If you cant do this then you might want to spin up an insatnce of PPT or word, and use that complete the install.
Next close yourself, or ask the user to close Excel.
Now all we need to do is save the new addin over the old one, with the same file name.
Tell the user its updated, and they should re-open Excel, close the install program.
This works well for me - although you need to remember the numbering system , in the file name and how that code works.
The below is the main guts of the code bit messy, but might help you out.
Private Sub CommandButton1_Click()
Dim RetVal As Long
MsgBox "To install the update, follow the installer programes directions." & vbNewLine & vbNewLine & _
"You will need to then closed down and restart Excel.", vbInformation + vbOKOnly, "::::UPDATE TRS:::::"
RetVal = Shell(gsDataBase1 & "\" & gsUpdatefolder & "\" & GetUpdateFileName(), 1)
ThisWorkbook.Close
Unload Me
End Sub
Private Sub CommandButton2_Click()
gbInUpdate = False
Unload Me
End Sub
Private Sub UserForm_Initialize()
Me.lbNew = GetServerVersion2
Me.lbCurrent.Caption = gcVersionNumber
'CheckVersionNumbers
End Sub
'''This method might be better, but is quite slow.
Public Sub GetServerVersion()
Set objshell = CreateObject("Shell.Application")
Set objFolder = objshell.Namespace(gsDataBase1 & "\" & gsUpdatefolder)
For Each strFileName In objFolder.Items
Me.lbNew.Caption = objFolder.GetDetailsOf(strFileName, 11)
Next
Set objshell = Nothing
End Sub
Public Function IsNewer() As Boolean
Dim curVer As Long
Dim newVer As Long
On Error GoTo Catch
curVer = CLng(Left(Replace(Me.lbCurrent, ".", ""), 2))
newVer = CLng(Left(Replace(Me.lbNew, ".", ""), 2))
If curVer < newVer Then
IsNewer = True
Else
IsNewer = False
End If
Exit Function
Catch:
IsNewer = False
End Function
Private Function GetServerVersion2() As String
On Error GoTo LEH
Dim strDocPath As String
Dim strCurrentFile As String
strDocPath = gsDataBase1 & "\" & gsUpdatefolder & "\"
strCurrentFile = Dir(strDocPath & "*.*")
'gets last file - randomly? should onl;y be one anyway!
'Do While strCurrentFile <> ""
GetServerVersion2 = Right(strCurrentFile, 11)
GetServerVersion2 = Left(GetServerVersion2, 7)
'Loop
Exit Function
LEH:
GetServerVersion2 = "0.Error"
End Function
'Basiclly a coop of GetSeverVerion, but just get the file name so the exe can be called by the shell operation under the update button
''seems clumbys, but works!
Private Function GetUpdateFileName() As String
On Error GoTo LEH
Dim strDocPath As String
Dim strCurrentFile As String
strDocPath = gsDataBase1 & "\" & gsUpdatefolder & "\"
GetUpdateFileName = Dir(strDocPath & "*.*")
Exit Function
LEH:
GetUpdateFileName = "0.Error"
End Function
I have this little VBA module that I call from one workbook to update all Excel Workbooks in a given folder. By update I mean it copies a module called GetActiveXControlValues and then runs this macro on each workbook in that folder. Now when I run this on my machine everything works fine. When my co-worker runs this same code with the same files, they gets a surprise after copying the module. When you go to look at the workbook that should have the new module called 'GetActiveXControlValues', instead there is no module by that name, instead it is called 'Module1'. In addition, when you look inside the new module it says 'Attachment has been removed' in red. I checked and my co-worker has the exact same Security Settings in Excel 2010 as I have.
I have enable all Macros and Trust VBA Project Object Model. I have Prompt me for enabling all ActiveX controls. I have Disable Trusted Documents unchecked and all the boxes on the Protected View tab. Anyone seen this before or have an idea what I can try to troubleshoot?
Sample Code:
Sub CopyModuleAndExecuteIt()
Dim wb As Workbook
Dim sFile As String
Dim sPath As String
Dim sFullMacroName As String
SetFolder
sPath = sExcelFolder
ChDir sPath
sFile = Dir("*.xls") ' File Naming Convention
Do While sFile <> "" ' Start of LOOP
' Open each Excel File in the specified folder
Set wb = Workbooks.Open(sPath & "\" & sFile) ' SET BP HERE!
Sleep (1000)
' Unprotect the Documents using SendKeys Hack
UnprotectVBADocument
' Import the GetActiveXControlValues Module into the Workbook
wb.VBProject.VBComponents.Import ("D:\GetActiveXControlValues.bas") ' SET BP HERE!
sFullMacroName = "'" & wb.Name & "'" & "!" & wb.VBProject.VBComponents.Item("GetActiveXControlValues").Name & ".GetActiveXControlValues"
' Run the GetActiveXControlValues Macro
Application.Run (sFullMacroName)
' Close the Workbook Saving Changes
wb.Close True
sFile = Dir
Loop ' End of LOOP
End Sub
If your co-worker has the exact same Security Settings in Excel 2010 as you have then the next thing that comes to my mind is the "Firewall". Check his firewall settings.
I was working to create an AddIn trough VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Attribute VB_Name = "Module_Name"
And you have to be sure that you .bas file is actualy is plain text.
I was working to create an AddIn with VBA code, i wrote the code in a Excel worksheet when i save it, i saved as text like this:
Sub Superheroes()
Dim sBeg as string, sEnd as String, sCatwoman as String, sAntMan as String
Dim vCode As Variant
'' Here is where i put the name i want to call my module
sBeg = "Attribute VB_Name = ""VBA_BasFile""" + vbCrLf + _
"Private Function fMix(sAnimal as String)as String "
sCatwoman = "Select case sAnimal"+ vbCrLf+ vbTab+"case ""cat"""+ _
vbCrLf+ vbTab+ "fMix = ""Catwoman"""
sAntMan = vbCrLf+ vbTab+"case ""Ant"""+ vbCrLf+ vbTab+ "fMix = ""AntMan"""+ _
vbCrLf+ "End Select"
sEnd = vbCrLf+ "End Sub"
vCode = Array(sBeg, sCatwoman, sAntMan, sEnd)
Workbooks.add
Range("A1").Resize(UBound(vCode) + 1, 1) = Application.Transpose(vCode)
With ActiveWorkbook
.SaveAs path + "VBA_BasFile.bas", xlTextPrinter
.Close False
End With
End Sub
With this i can Call any procedure or function in the VBA_BasFile when i importe to another Excel Workbook.