Is there any method to add macro to Excel file programmatically ?
I have too many Excel files I want to add a macro to them.
Adding manually (by hand) seems impossible.
I need to create a tool to do this.
Yes, you can do this programatically, you can access the VB Integrated Development Environment through code. The following website are excellent for learning about the VBIDE, I've used them to put together this code. If you run WorkbookModuleImporttwo open dialog boxes will pop up, the first asking for workbooks to import the modules into, the second to select the modules for importing.
Sub WorkbookModuleImport()
Dim ii As Integer, vFileNames As Variant, vModules As Variant
'We'll use the Application.GetOpenFilename to get a list of all the excel workbooks we want to import into
vFileNames = Application.GetOpenFilename(",*.xls;*.xlsx;*.xlsm", , "Select Workbooks to Import Modules To", , True)
'If the result is not an array it means the cancel button has been pressed
If Not IsArray(vFileNames) Then Exit Sub
'Use the same method to get all the modules/classes/forms to input
vModules = Application.GetOpenFilename(",*.cls, *.bas, *.frm", , "Select Modules/Forms/Class Modules to Import", , True)
If Not IsArray(vModules) Then Exit Sub
'Now loop through all the workbooks to import the modules
For ii = LBound(vFileNames) To UBound(vFileNames)
Call ImportModules(VBA.CStr(vFileNames(ii)), vModules)
Next ii
End Sub
Public Sub ImportModules(sWorkbookName As String, vModules As Variant)
Dim cmpComponents As VBIDE.VBComponents, ii As Integer
Dim wkbTarget As Excel.Workbook
'We need to open the workbook in order to be able to import the code module
Set wkbTarget = Workbooks.Open(sWorkbookName)
'If the project is protected with a password we can't import so just set tell us in the immediate window
If wkbTarget.VBProject.Protection = 1 Then
'Give a message
Debug.Print wkbTarget.Name & " has a protected project, cannot import module"
GoTo Cancelline
End If
'This is where we set the reference to the components of the Visual Basic project
Set cmpComponents = wkbTarget.VBProject.VBComponents
'Loop through all the modules to import
For ii = LBound(vModules) To UBound(vModules)
cmpComponents.Import vModules(ii)
Next ii
Cancelline:
'If it's in Excel 2007+ format but doesn't already have macros, we'll have to save it as a macro workbook
If wkbTarget.FileFormat = xlOpenXMLWorkbook Then
wkbTarget.SaveAs wkbTarget.Name, xlOpenXMLWorkbookMacroEnabled
wkbTarget.Close SaveChanges:=False
Else
'Otherwise, just save the workbook and close it
wkbTarget.Close SaveChanges:=True
End If
'I don't trust excel, so set the workbook object to nothing
Set wkbTarget = Nothing
End Sub
These webpages are great references:
http://www.cpearson.com/excel/vbe.aspx and
http://www.rondebruin.nl/vbaimportexport.htm. I used Ron's as a starting point.
Related
Someone posted a question on mrexcel, asking how to replace modules in existing workbooks with new ones:
https://www.mrexcel.com/forum/excel-questions/760732-vba-automatically-replace-modules-several-workbooks.html
They answered their question with others support as follows:
Sub Update_Workbooks()
'This macro requires that a reference to Microsoft Scripting Routine
'be selected under Tools\References in order for it to work.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim fso As New FileSystemObject
Dim source As Scripting.Folder
Dim wbFile As Scripting.File
Dim book As Excel.Workbook
Dim sheet As Excel.Worksheet
Dim Filename As String
Dim ModuleFile As String
Dim Element As Object
Set source = fso.GetFolder("C:\Users\Desktop\Testing") 'we will know this since all of the files will be in one folder
For Each wbFile In source.Files
If fso.GetExtensionName(wbFile.Name) = "xlsm" Then 'we will konw this too. All files will be .xlsm
Set book = Workbooks.Open(wbFile.path)
Filename = FileNameOnly(wbFile.Name)
'This will remove all modules including ClassModules and UserForms.
'It will keep all object modules like (sheets, ThisWorkbook)
On Error Resume Next
For Each Element In ActiveWorkbook.VBProject.VBComponents
ActiveWorkbook.VBProject.VBComponents.Remove Element
Next
On Error GoTo ErrHandle
' Export Module1 from updating workbook
ModuleFile = Application.DefaultFilePath & "\tempmodxxx.bas"
Workbooks("Update Multiple Workbooks.xlsm").VBProject.VBComponents("Module1") _
.Export ModuleFile
' Replace Module1 in Userbook
Set VBP = Workbooks(Filename).VBProject
On Error Resume Next
With VBP.VBComponents
.Import ModuleFile
End With
' Delete the temporary module file
Kill ModuleFile
book.Close True
End If
Next
Exit Sub
ErrHandle:
' Did an error occur?
MsgBox "ERROR. The module may not have been replaced.", _
vbCritical
End Sub
However, its quite large, and wanted to show a simple way of doing the same thing. Also, I found that when Importing the Modules to a different sheet, the ThisWorkBook and Sheet files are also imported as ClassModules. This is not always desired, so see answer below for alternative options!
You can import (or export if you flip the order) Modules from a different sheet using the following Sub:
Sub import_mods()
'First define each module you're looking to
'take from the excel sheet "Workbook_with_Modules.xlsm"
For Each Element In Workbooks("Workbook_with_Modules.xlsm").VBProject.VBComponents
'MsgBox Element.Name 'I ran this first to see which modules are available
'First, export each module from the "Workbook_with_Modules.xlsm"
Workbooks("Workbook_with_Modules.xlsm").VBProject.VBComponents(Element.Name).Export (Element.Name)
'Then, Import them into the current Workbook
Workbooks(ThisWorkbook.Name).VBProject.VBComponents.Import (Element.Name)
Next Element
End Sub
I created a separate sub to delete the one's I'm not interested in keeping. You can Call it directly from the previous sub if you prefer, or build the If statement for the type into the previous sub as well, but for this example's sake, its a separate Sub entirely.
Sub rems()
'Types:
' 100 = Sheets and ThisWorkbook for current Workbook
' 1 = Modules (such as "Module1")
' 2 = ClassModules (such as other sheets from a different Workbook "ThisWorkBook1")
For Each Element In Workbooks(ThisWorkbook.Name).VBProject.VBComponents
'I first tested the types and corresponding number
'MsgBox Workbooks(ThisWorkbook.Name).VBProject.VBComponents(Element.Name).Type
'Now, the If function for removing all ClassModules (Type = 2)
If Workbooks(ThisWorkbook.Name).VBProject.VBComponents(Element.Name).Type = 2 Then
Workbooks(ThisWorkbook.Name).VBProject.VBComponents.Remove Element
End If
Next Element
End Sub
Hope this helps anyone!
I have a problem importing the modules, they are imported adding a 1 at the end of the name.
I tried to delete them before, and then import all, but the deletion is not executed until the sub ends.
Instead of having all the macro's stored in each workbook, we would like to have them stored in one global one. We tried using Personal.xlsb file, however every time excel crashes or system administrator forced restart with excel open it created personal.v.01 ....v.100 files, and they interfered with each other, got corrupted etc.. So instead we are trying to add a small macro to each excel workbook we make which then should open a global excel workbook with all the macros, however it does not open it(normal.xlsb), where is the problem? If I manually run it it works fine, it just does not autorun..
Option Explicit
Public Sub Workbook_Open()
Dim sFullName As String
Dim xlApp As Excel.Application
Dim wbReturn As Workbook
sFullName = "Z:\Dokumentstyring\normal.xlsb"
Set xlApp = GetObject(, "Excel.Application") 'need to do so to open it in same instance otherwise the global macros can not be called.
Set wbReturn = xlApp.Workbooks.Open(filename:=sFullName, ReadOnly:=True)
If wbReturn Is Nothing Then
MsgBox "Failed to open workbook, maybe z drive is down?"
Else
ThisWorkbook.Activate'Dont know how to pass object to modules, so instead activate it and in createbutton set wb= activeworkbook..
Application.Run ("normal.xlsb!CreateButtons")
End If
End Sub
Public Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wb As Workbook
For Each wb In Application.Workbooks
If InStr(UCase(wb.Name), "PARTSLIST") > 0 And wb.Name <> ThisWorkbook.Name Then Exit Sub
Next wb
On Error Resume Next
Workbooks("normal.xlsb").Close
Workbooks("filter.xlsx").Close
End Sub
You create your addin, as just an empty workbook, holding nothing but the code
Like this
Then you add a reference to it, in the workbook that you wish to use, in VBA, like this. My Documents, is a folder on a network drive, not "my documents" local.
And then you can call like so.
So based on input from #Nathan_Sav and #Ralph I have come to a partly good solution:
I have called my addinn Normal and saved this on Z:Dokumenstyring\Normal.xlam
I then removed all the code in Thisworkbook of Normal:
Private Sub Workbook_Open()
Dim ExcelArgs As String
Dim arg As String
ExcelArgs = Environ("ExcelArgs")
'Call deleteMacros.deletePersonalFiles
'MsgBox ExcelArgs
If InStr(UCase(ExcelArgs), "CREO,") > 0 Then
Application.DisplayAlerts = False
If Len(ExcelArgs) > Len("CREO,") Then
arg = Split(ExcelArgs, ",")(1)
Call Creo.addNewPartToPartslist(arg)
End If
Application.DisplayAlerts = True
End If
If InStr(UCase(ExcelArgs), "DOKLIST,") > 0 Then
Application.DisplayAlerts = False
If Len(ExcelArgs) > Len("DOKLIST,") Then
arg = Split(ExcelArgs, ",")(1)
Call ProsjektListen.dbDumpDocOut(arg)
End If
Application.DisplayAlerts = True
End If
and put this in a new workbook called Z:Dokumenstyring\Creo.xlsm
I have so edited all my bat files(which previously were using personal.xlsb):
echo "Launch excel"
Set ExcelArgs=CREO,ADDPART
"C:\Program Files (x86)\Microsoft Office\OFFICE16\Excel.exe" /x /r "z:\Dokumentstyring\Creo.xlsm"
So when I run the bat file it adds a parameter to enviroment, start creo.xlsm, which then starts the addin which launch my userform.
So if I now want to update the look of that that userform I do this by modifying the Z:Dokumenstyring\NormalDebug.xlam, then i save a copy which i write over Z:Dokumenstyring\Normal.xlam and I also told every user to not copy the addin to the default location in excel but keep it in Z:Dokumenstyring\Normal.xlam.
My shapes in my excel sheets seems to work with just the macro name in the procedure, however there might be an conflict if two procedures have the same name, but located in different procedures. So I also altered this to
ws1.Shapes(tempName).OnAction = "Normal.xlam!Custom_Button_Click"
However every click starts a new instance of the addin, how to avoid this?
I have a list of excel files in a spreadsheet. I'd like to loop through them and add a worksheet event to each. Save it, close it and move on to the next. The problem is that when I reopen (manually) the workbook the code is gone.
Inside the for each loop:
Set xl = Workbooks.Open(filepath)
addCode xl 'subroutine to add code
xl.Save
xl.Close SaveChanges:=False
The addCode subroutine is:
Sub addCode(book As Excel.Workbook)
acsh = book.ActiveSheet.CodeName
startline = book.VBProject.VBComponents(acsh).CodeModule.CreateEventProc("SelectionChange", "Worksheet") + 1
book.VBProject.VBComponents(acsh).CodeModule.InsertLines startline, codetoadd
End Sub
If I comment out xl.Close the code is in the workbook and works. I can manually save and close the file and the code remains. I've added a break point between xl.save and xl.close and made a copy of the file. After the code is done neither has the changes. I've tried using xl.saveas and xl.close SaveChanges:=True. All have identical results.
I'm using Excel 2013, I've told excel to trust access to the VBA object model. I've tried using XLS files and XLSM files. Obviously XLSX won't work.
Here is some sample code which is working for me on Excel 2010. The changes I made to your example code are:
use a .xlsm for the target workbook - I know you said you already did that.
reference a specific worksheet in the AddCode sub rather than pick up the sheet name from ActiveSheet.
set the workbook dirty status per Ralph's comment
Don't set the SaveChanges flag when closing the target workbook
Other than that, my version is pretty similar to yours. I think it is the wb.Saved = False line that does the trick i.e. the dirty flag. I tried to use the SaveAs method on the VBProject itself thinking it would be the same as hitting the save button when you are in the VBA Editor itself. However, this just gives unhelpful errors.
Here's the sample code:
Option Explicit
Sub Test()
Dim wbTarget As Workbook
Dim strCode As String
' get target workbook
Set wbTarget = Workbooks.Open("\\server\path\Book3.xlsm")
' test setting code to worksheet change
strCode = "Debug.Print ""Sheet selection changed to: "" & Target.Address"
AddWorksheetChangeCode wbTarget, "Sheet1", strCode
' test saving the target workbook
With wbTarget
' set book to dirty to force the save
.Saved = False
.Save
.Close
End With
End Sub
Sub AddWorksheetChangeCode(ByRef wb As Workbook, strWorksheetName As String, strCode As String)
Dim intInsertLine As Integer
' create stub for event and get line to insert
intInsertLine = wb.VBProject.VBComponents(strWorksheetName).CodeModule.CreateEventProc("SelectionChange", "Worksheet") + 1
' add event logic
wb.VBProject.VBComponents(strWorksheetName).CodeModule.InsertLines intInsertLine, strCode
End Sub
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 am trying to copy the values of one column in a sheet to a text file. The code I currently have causes runtime error 434.
Sheets("Output to fcf.1").Columns("A").SaveToText "P:\4_Calcs\02. Flag Mapping\test_.txt"
If I try and save the whole sheet
Sheets("Output to fcf.2").SaveToText "P:\Clear Project Drive\CLE10276 AWS SMP Model Assessmnts\4_Calcs\02. Flag Mapping\test2_.txt"
I get the entire sheet converted into text rather than just the text in the sheet. Is there a simple way to do this?
Thanks in advance!
Not sure which Excel version you have but I don't see a method for SaveToText.
But this procedure should work, or at least get you started...
Sub SaveColumn(sheetName As String, columnName As String, fileName As String)
Dim cell
Dim fso
Dim file
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile(fileName, True)
For Each cell In Sheets(sheetName).Columns(columnName).Cells
If cell.Value <> "" Then
file.WriteLine cell.Value
End If
Next
file.Close
Set file = Nothing
Set fso = Nothing
End Sub
To call it...
SaveColumn "Output to fcf.1", "A", "P:\4_Calcs\02. Flag Mapping\test_.txt"
This is designed to be used as a macro.
Step by step guide:
1) From excel, hit Alt+F11 on your keyboard.
2) From the menu bar, click Insert, then Module
3) Copy and paste the code provided below into the new module that opens.
NOTE: DocPath = "C:\docs\data.txt" should be wherever you want the output file saved, including the file's actual name. Remember, the folder you want the output file to be located in should ALREADY exist. This does not create the folder if it can't be found.
4) From the menu bar, click Tools, then References. Make sure both "Microsoft Office 14.0 Object Library" as well as "Microsoft Word 14.0 Object Library" are checked, and hit okay (See screenshot for details)
5) Save the document as an .xlsm file (This file type supports Macros)
6) Close the VBA editor. Back in Excel, on the ribbon click View and then Macros. Your new macro should be in the list as ExportToTXT
7) Select it and hit run.
Sub ExportToTXT()
Dim DocPath As String
Dim MsgBoxCompleted
Columns("A").Select
Dim AppWord As Word.Application
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = False
Selection.Copy
DocPath = "C:\docs\data.txt"
'Create and save txt file
AppWord.Documents.Add
AppWord.Selection.Paste
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
Application.CutCopyMode = False
AppWord.Quit (wdDoNotSaveChanges)
Set AppWord = Nothing
MsgBoxCompleted = MsgBox("Process complete.", vbOKOnly, "Process complete")
End Sub
Good luck, and if you have any questions, don't hesitate to ask.
NOTE: These directions might seem overly simplified for your skill level, but I wrote the answer like this to potentially help others in the future.
EDIT
Change
DocPath = "C:\docs\data.txt"
to
DocPath = "C:\docs\data.fcf"
And change
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath, FileFormat:=wdFormatText
to
AppWord.ActiveDocument.SaveAs2 Filename:=DocPath
The output file will be .fcf format. Whether or not it will open properly is something I'm not sure of. You'd have to test in the program you're using.