My job we have a lot of reports that's generated. Using a modular approach I'm trying to set up a Excel workbook that dynamically creates sheets based on what report that's picked from Sheet("MainMenu")
Anyways, in the dynamic sheet I have the following
Public Sub OFFD_Report_Parse()
Init 'just declares workbook and worksheet globals
If shtTCL.Visible = False Then shtTCL.Visible = True
shtTCL.Activate
shtMenu.Visible = False
Dim rngBtn1, rngBtn2, rngBtn3, rngBtn4 As Range
Dim btn1, btn2, btn3, btn4 As Button
Set rngBtn1 = shtTCL.Range("B10")
Set btn1 = shtTCL.Buttons.Add(rngBtn1.Left, rngBtn1.Top, rngBtn1.Width, rngBtn1.Height)
With btn1
.OnAction = "TCL1"
.Caption = "Copy 1"
End With
When ran I get Run-time error '1004' Unable to set the OnAction property of the Button Class
The sub it's calling:
Sub TCL1()
Clipboard ("SELECT ORDER WITH FLAG.DELETE = " & Chr(34) & "Y" & Chr(34) & Chr(13))
CopyMsg
End Sub
Is in the same module. I've used this exact method of code in another excel file with no issues which is really making me stumped.
Thank you in advance!!!!
There are two things you need to do to solve your problem.
The code must be in a standard module, not the sheet-behind
You can't have a numeric suffix on the action
I also notice that you're trying to dim a bunch of variables instead of using an array or collection. Only dim one variable per line. Each variable needs the As statement. Those that are omitted are declared as a variant by default.
If you use a collection you can dynamically generate the array without knowing how many elements it will have up front.
Where I explicitly call out the index of the collection (0) you could instead use a loop and a loop counter.
EXAMPLE:
Option Explicit
Public Sub OFFDReportParse()
Init 'just declares workbook and worksheet globals
If shtTCL.Visible = False Then shtTCL.Visible = True
shtTCL.Activate
shtMenu.Visible = False
Dim buttonRanges As Collection
Dim newButtons As Collection
buttonRanges.Add shtTCL.Range("B10")
newButtons.Add shtTCL.Buttons.Add(buttonRanges(0).Left, buttonRanges(0).Top, buttonRanges(0).Width, buttonRanges(0).Height)
With newButtons(0)
.OnAction = "TCLaction"
.Caption = "Copy 1"
End With
End Sub
Public Sub TCLaction()
Clipboard ("SELECT ORDER WITH FLAG.DELETE = " & Chr(34) & "Y" & Chr(34) & Chr(13))
CopyMsg
End Sub
Related
i am trying to access variables across several modules, sheets and workbooks.
i'm not even able to share them across modules in same workbook...
i wonder what's missing. In this case, i want to open a file and then share its name across modules in order to manipulate it through other functions.
When running this procedure "Sub get_workbook_and_sheets_names_S", it asks to run a macro (I chose Sub myMain), but then I only got the macro output.
Sub myMain()
Dim i As Integer
Static v_sheet_name_S As Variant
Static v_workbook_name_S As Variant
'Call f_FSOGetFileName_S
With Application.Workbooks(f_FSOGetFileName_S)
v_workbook_name_S = .Name
Debug.Print "this is WORKBOOK : " & v_workbook_name_S
For i = 1 To .Sheets.Count
v_sheet_name_S = .Sheets(i).Name
Debug.Print "this is workbook SHEET : " & v_sheet_name_S
Next
End With
'Call f_FSOGetFileName_T
End Sub
Function f_FSOGetFileName_S() 'OPEN SOURCE FILE
Dim v_strFile_S As String
Dim v_FileName_S As String
Dim v_FSO_S As New FileSystemObject
Dim v_FileNameWOExt_S As Variant
Set v_FSO_S = CreateObject("Scripting.FileSystemObject")
'get file full path
v_strFile_S = Application.GetOpenFilename(filefilter:="Excel files,*.x*", Title:="select SOURCE file")
Workbooks.Open Filename:=v_strFile_S
'Get File Name
v_FileName_S = v_FSO_S.GetFileName(v_strFile_S)
'Get File Name no Extension
v_FileNameWOExt_S = Left(v_FileName_S, InStr(v_FileName_S, ".") - 1)
f_FSOGetFileName_S = v_FileName_S 'FUNCTION RESULT
End Function
Sub get_workbook_and_sheets_names_S(v_workbook_name_S, v_sheet_name_S)
Debug.Print "Source workbook name : " & v_workbook_name_S
Debug.Print "Source sheet name : " & v_sheet_name_S
End Sub
In order to create a Global variable, please proceed in the next way:
Create a Public variable on top of a standard module (in the declarations area):
Public v_workbook_name_S As String
This variable can be accessed/used from all modules of the workbook where it has been declared. You should simple use:
Debug.print v_workbook_name_S
Of course, the variable must previously receive a value...
In order to be accessible from other workbooks, you should also create a function (**not Private) in the workbook where the global variable has been declared. In a standard module, too:
Sub setGobVarStr()
v_workbook_name_S = "myString"
End Sub
The global variable value can be accessed colling the above function, using:
Sub testReadGlobalVar()
Dim wbName As String, myName As String
wbName = "Teste Forum StackOverflow Last.xlsm"
myName = Application.Run("'" & wbName & "'!getWbName")
Debug.Print myName
End Sub
Of course, the global variable should previously received a value. If not, the code will return a VBNullString, anyhow...
Note:
You must not declare the same variable inside the colling Sub/Function! In such a case, the code will not raise any error, but it will rewrite the global variable and return a VBnullString, too...
Looking to add a second function with the click of the command button in Excel with VBA code - first function populates data from worksheet one (an order form) to a database log in worksheet two. Looking for the second function to be carried out to be an auto-save with cell value from the order form. Thank you!
Private Sub CommandButton1_Click()
Dim OrderDate As String, PONumber As String, Vendor As String, ShipTo As String, SKU As String
Dim R As Long, LastSKURow As Long, NextDBRow As Long, OFrm As Worksheet, DB As Worksheet
Set OFrm = Worksheets("Order Form 1")
Set DB = Worksheets("Database")
OrderDate = OFrm.Range("B3")
PONumber = OFrm.Range("D3")
Vendor = OFrm.Range("B7")
ShipTo = OFrm.Range("D7")
LastSKURow = OFrm.Cells(OFrm.Rows.Count, "F").End(xlUp).Row
For R = 3 To LastSKURow
SKU = OFrm.Range("F" & R).Value
NextDBRow = DB.Cells(DB.Rows.Count, "A").End(xlUp).Row + 1
DB.Range("A" & NextDBRow).Value = OrderDate
DB.Range("B" & NextDBRow).Value = PONumber
DB.Range("C" & NextDBRow).Value = Vendor
DB.Range("D" & NextDBRow).Value = ShipTo
DB.Range("E" & NextDBRow).Value = SKU
Next R
Application.ScreenUpdating = False
Dim Path As String
Dim filename As String
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,
Path = "C:\PDF\"
filename = OFrm.Range("D3")
OFrm.SaveAs filename:=Path & filename & ".pdf", FileFormat:=xlPDF
OpenAfterPublish:=False
Application.ScreenUpdating = True
End Sub
by auto-save do you mean that it saves the excel workbook? if so you could add something like this...
Application.ActiveWorkbook.Save
If this is not what you are looking for please let me know...
Sorry it took a few days, I've been quite busy.
Based on your previous comment this subroutine that I wrote should resolve your problem. I chose to save the file as a pdf with the assumption that you've set a print area to your form. I chose a pdf because you stated it was an order form and the assumption is that the form will not be edited later. I opted to it because it was a form and there may be some calculated fields attached to another sheet which would not work if you detached the worksheet. If however you decide that you just want a copy of the worksheet I've included the code for it as well. All you need to do is fill in the areas with the comments and attach this function to a command button :). Please let me know if you would like additional information about how to do this.
For the pdf function you can see the information here: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/workbook-exportasfixedformat-method-excel
For the Save As information you can see the information here: https://msdn.microsoft.com/en-us/vba/excel-vba/articles/worksheet-saveas-method-excel
Public Sub savefile()
Dim wb As Workbook
Dim ws As Worksheet
Dim rngfilename As Range
Dim strSavePath As String
'assumptions:
'you are saving the file to a fixed location and the name of the file within the range is continually changing
'you have set the print areas
Set wb = Application.ActiveWorkbook
Set ws = wb.ActiveSheet
Set rngfilename = ws.Range("A1") 'the range that contains your filename
strSavePath = "C:/" 'the location that you would like to save your file
'ensure that there is a value within the filename field declared above
If rngfilename.Value = "" Or Len(rngfilename) = 0 Then
MsgBox "You have not entered a filename"
Exit Sub
End If
'if you do not have print areas set ignore print areas to true in the function bellow
ws.ExportAsFixedFormat xlTypePDF, strSavePath & rngfilename.Value, xlQualityStandard
'for the save as function
'ws.SaveAs strSavePathe & rngfilename.Value
End Sub
I am trying to make my excel macro dynamic. The excel macro essentially looks at only 2 columns, one which contains the name and the other contains the numeric part. I have my macro working perfectly, the only problem is that it is hard coded when I created the program. In my code, I hard coded the name in column 2 and the numeric part in column 3. However, that is not the case in real life. The name and numeric data could appear in column 1 and 5, for example. I've been manually rearranging the data in the columns so that it fits into what hard coded. However, I want to make this process dynamic and less manual work for the user.
There are 5 different versions of spreadsheets this macro will be used on and in each spreadsheet, the name and number columns are different. I am looking to make a user form box of some sort, where the user selects "Vendor XYZ" and since Vendor XYZ always sends their data sheets the same way I know that Vendor XYZ's name column is 2 and number is 4. So I was thinking that the dictionary would be something in the form of {Vendor XYZ: 2,4} (where the first number is the name column and the second number is the numeric columnnumber...I know the syntax is wrong)
I think my work around this would be to hard code the different vendors and then use if statements ( I haven't tried it yet)
I will have a user input/dropdown box of 5 different vendors. Then something like
If userinput="A"
then namecol=2 and numcol=1
If userinput="B"
then namecol="3" and numcol="4"
I don't know if that would even work. The problem with that is that the number of vendors is small now, but will be scaling up and I can't do that if we have 100 or 1000 vendors.
Any ideas?
Depending on how your initial dataset is retrieved, you can use something like this:
Public Function GetHeaderIndices(ByVal InputData As Variant) As Scripting.Dictionary
If IsEmpty(InputData) Then Exit Function
Dim HeaderIndices As Scripting.Dictionary
Set HeaderIndices = New Scripting.Dictionary
HeaderIndices.CompareMode = TextCompare
Dim i As Long
For i = LBound(InputData, 2) To UBound(InputData, 2)
If Not HeaderIndices.Exists(Trim(InputData(LBound(InputData, 1), i))) Then _
HeaderIndices.Add Trim(InputData(LBound(InputData, 1), i)), i
Next
Set GetHeaderIndices = HeaderIndices
End Function
This Function takes an array as an input and gives the user a dictionary with the indices of the headers from the input.
If you are smart (and I say this because too many users just don't use tables) you will have your data in a table, and you will have named that table. If you did, you could do something like this:
Sub DoSomething()
Dim MyData as Variant
MyData = ThisWorkbook.Worksheets("MyDataSheet").ListObjects("MyTableName").Range.Value
End Sub
So, if you data looked like this:
Foo Baz Bar
1 Car Apple
3 Van Orange
2 Truck Banana
The function would give you a dictionary like:
Keys Items
Foo 1
Baz 2
Bar 3
Then your subroutines could do something like this:
Sub DoEverything()
Dim MyData as Variant
MyData = ThisWorkbook.Worksheets("MyDataSheet").ListObjects("MyTableName").Range.Value
DoSomething(MyData)
End Sub
Sub DoSomething(ByRef MyData as Variant)
Dim HeaderIndices as Scripting.Dictionary
Set HeaderIndices = GetHeaderIndices(MyData)
Dim i as Long
' Loop through all the rows after the header row.
For i = LBound(MyData, 1) + 1 to Ubound(MyData, 1)
If MyData(i, HeaderIndices("Baz")) = "Truck" Then
?MyData(i, HeaderIndices("Foo"))
?MyData(i, HeaderIndices("Baz"))
?MyData(i, HeaderIndices("Bar"))
End If
Next
End Sub
This does require a reference to Scripting.Runtime so if you don't want to add a reference you will need to change any reference to As Scripting.Dictionary to As Object and any New Scripting.Dictionary to CreateObject("Scripting.Dictionary").
Alternatively, I use the following code module to take care of adding references programmatically for all my users:
Public Sub PrepareReferences()
If CheckForAccess Then
RemoveBrokenReferences
AddReferencebyGUID "{420B2830-E718-11CF-893D-00A0C9054228}"
End If
End Sub
Public Sub AddReferencebyGUID(ByVal ReferenceGUID As String)
Dim Reference As Variant
Dim i As Long
' Set to continue in case of error
On Error Resume Next
' Add the reference
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=ReferenceGUID, Major:=1, Minor:=0
' If an error was encountered, inform the user
Select Case Err.Number
Case 32813
' Reference already in use. No action necessary
Case vbNullString
' Reference added without issue
Case Else
' An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select
On Error GoTo 0
End Sub
Private Sub RemoveBrokenReferences()
' Reference is a Variant here since it requires an external reference.
' It isnt possible to ensure that the external reference is checked when this process runs.
Dim Reference As Variant
Dim i As Long
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set Reference = ThisWorkbook.VBProject.References.Item(i)
If Reference.IsBroken Then
ThisWorkbook.VBProject.References.Remove Reference
End If
Next i
End Sub
Public Function CheckForAccess() As Boolean
' Checks to ensure access to the Object Model is set
Dim VBP As Variant
If Val(Application.Version) >= 10 Then
On Error Resume Next
Set VBP = ThisWorkbook.VBProject
If Err.Number <> 0 Then
MsgBox "Please pay attention to this message." _
& vbCrLf & vbCrLf & "Your security settings do not allow this procedure to run." _
& vbCrLf & vbCrLf & "To change your security setting:" _
& vbCrLf & vbCrLf & " 1. Select File - Options - Trust Center - Trust Center Settings - Macro Settings." & vbCrLf _
& " 2. Place a checkmark next to 'Trust access to the VBA project object model.'" _
& vbCrLf & "Once you have completed this process, please save and reopen the workbook." _
& vbCrLf & "Please reach out for assistance with this process.", _
vbCritical
CheckForAccess = False
Err.Clear
Exit Function
End If
End If
CheckForAccess = True
End Function
And I have the following command in each Workbook_Open event (less than ideal, but only good solution I have so far)
Private Sub Workbook_Open()
PrepareReferences
End Sub
I understand similar questions with these errors have been posted before, but I found nothing when it came to formatting tables so don't close this please. In my VBA code in MS Access 2013 it exports data from MS Access to Excel. 6 different queries get exported into 1 excel file, each on a different worksheet. This works fine. I then format each sheet to have all the data in a table. I have a form which lets the user choose the path to save the file. If it is the first time creating the file, it works properly. If it is the second time creating the file in that same directory, it doesn't work and it gives me the error:
Run-time error 1004: Method Range of object _Global failed
I figured this was because I was overwriting my file instead of deleting it and recreating it. So I added in some code to check if the file exists, and if it does, delete it. I added breakpoints and while running through this part of the code, I was watching my documents folder. The file successfully got deleted and then recreated which is what I wanted. It still gave me that error. I manually went to delete the file and then reran my code again. It worked properly.
How come I need to manually delete this file in order to rerun my code? Or is it something else that is causing the problem? Here is the important parts of my code as the whole thing is too long to post:
'Checks if a file exists, then checks if it is open
Private Sub checkFile(path As String)
Dim openCheck As Boolean
'If file exists, make sure it isn't open. If it doesn't, create it
If Dir(path) <> "" Then
openCheck = IsFileLocked(path)
If openCheck = True Then
MsgBox "Please close the file in " & path & " first and try again."
End
Else
deleteFile (path)
End If
Else
End If
End Sub
Sub deleteFile(ByVal FileToDelete As String)
SetAttr FileToDelete, vbNormal
Kill FileToDelete
End Sub
Private Sub dumpButton_Click()
On Error GoTo PROC_ERR
Dim path As String
Dim testBool As Boolean
path = pathLabel4.Caption
path = path & Format(Date, "yyyy-mm-dd") & ".xlsx"
checkFile (path)
dumpQueries (path)
formatFile (path)
'Error Handling
PROC_ERR:
If Err.Number = 2001 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 2501 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 3021 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 2302 Then
MsgBox "A file may have been sent to " & path
Exit Sub
ElseIf Err.Number = 0 Then
MsgBox "Your file has been stored in " & pathLabel4.Caption
Exit Sub
Else
MsgBox Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & "New Error. Please contact the IT department."
End If
Private Sub dumpQueries(path As String)
Dim obj As AccessObject, dB As Object
Set dB = Application.CurrentData
For Each obj In dB.AllQueries
testBool = InStr(obj.name, "Sys")
If testBool <> True Then
If obj.name = "example1" Or obj.name = "example2" Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, obj.name, path, True, editWorksheetName(obj.name)
End If
End If
Next obj
End Sub
'Autofits the cells in every worksheet
Private Sub formatFile(path As String)
Dim Date1 As Date, strReportAddress As String
Dim objActiveWkb As Object, appExcel As Object
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = False
appExcel.Application.Workbooks.Open (path)
Set objActiveWkb = appExcel.Application.ActiveWorkbook
With objActiveWkb
Dim i As Integer
For i = 1 To .Worksheets.count
.Worksheets(i).Select
.Worksheets(i).Cells.EntireColumn.AutoFit
.Worksheets(i).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).name = "myTable1"
Next
End With
appExcel.ActiveWindow.TabRatio = 0.7
objActiveWkb.Close savechanges:=True
appExcel.Application.Quit
Set objActiveWkb = Nothing: Set appExcel = Nothing
End Sub
The error occurs near the bottom of the code. It's the line:
.Worksheets(i).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).name = "myTable1"
There may be a couple functions I left out but they work fine and shouldn't be needed for answering the question.
This is the only relevant code:
Set objActiveWkb = appExcel.Application.ActiveWorkbook
With objActiveWkb
Dim i As Integer
For i = 1 To .Worksheets.count
.Worksheets(i).Select
.Worksheets(i).Cells.EntireColumn.AutoFit
.Worksheets(i).ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes).name = "myTable1"
Next
End With
Things get easier to follow when you trim the fluff away and start naming things - there's no need to .Select anything, appExcel is already an Application object, and there's no need to make a copy reference to the active workbook just to use in a With block, especially if that copy is going to be an Object variable anyway - if the copy were a Workbook object then you would at least get IntelliSense for its members...
Your source range is ambiguous. Range("A1") in Excel-VBA is an implicit reference to the active worksheet.. but this is Access-VBA, so there's no such thing, xlSrcRange is an enum value defined in the Excel object model, so if you don't have a reference to the Excel object model (you're late-binding this, right?), and Option Explicit isn't specified, then xlSrcRange is treated by VBA like just another undeclared/uninitialized variable, and therefore you're passing a 0 there, and the xlSrcRange enum value stands for a 1 - and 0 happens to be the underlying value for xlSrcExternal. Same with xlYes.
Since we cannot possibly guess what the actual source range is supposed to be from the code you posted, I'm leaving you with this:
Dim target As Object
Dim srcRange As Object
Set srcRange = TODO
With appExcel.ActiveWorkbook
Dim i As Integer
For i = 1 To .Worksheets.Count
.Worksheets(i).Cells.EntireColumn.AutoFit
Set target = .Worksheets(i).ListObjects.Add(1, srcRange, , 1)
If target Is Not Nothing Then target.Name = "myTable1"
Next
End With
Side question... why name the table myTable1 when Excel will already have named it Table1 anyway? Also note, if .Add fails, your code blows up with a runtime error 91 because you'd be calling .Add off Nothing. Verifying that the target is not Nothing before setting its Name will avoid that.
To answer your question in the comments:
#Mat'sMug is this what you were talking about? because it gives me this error: "438: Object doesn't support this property or method" Here's the code: .Worksheets(i).ListObjects.Add(SourceType:=xlSrcRange, Source:=.Cells(1).CurrentRegion, _ XlListObjectHasHeaders:=xlYes, TableStylename:="TableStyleMedium1").name = "Table"
The reason this throws a 438 is because your With block variable is a Workbook object, and a Workbook object doesn't have a .Range member.
What I was talking about, is that in Excel VBA unqualified calls to Range, Row, Column, and Cells are implicitly referencing the ActiveSheet, and unqualified calls to Worksheets, Sheets and Names are implicitly referencing the ActiveWorkbook - that's a recurrent problem in a lot of VBA code and a very common mistake to make. The solution is basically to say what you mean, and mean what you say; in this case the failure is on "mean what you say" - the unqualified Range("A1") call is, according to the error message, calling [_Globals].Range("A1")... which is weird because it implies that you're referencing the Excel object model library, which means your late-binding and Object variables could just as well be early-bound: why deal with Object variables and lack of IntelliSense when you're already referencing the library you're late-binding to?
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