Save a Macro

D

ducttape

I need to save 2 functions and a macro into multiple files (100 files in
total). I am unable to use the personel.xls function because I will not
be the only person needed to use the macro. Just to be clear, everyone
who opens the file (from the database) must be able to run the macro.

If no solution can be found, I will be forced to copy and paste the
macro into the other 100 files. I can use all the help avialable.
 
E

exceluserforeman

Assign a toolbar button to the macro

Make available to all Open workbooks.
 
D

ducttape

That does not do quite what I need

I want to be able have the source code of the macro transfered to al
the files. My macro is an Auto_Open which needs to be in all of the
other files on the DB.
 
D

ducttape

I fugured out what I needed to do.
Every '.nvs' file in the folder 'MyPath' will have the module called
'Tracker' added to it. That module will be populated with code from the
file 'pathtracker.txt'

Here is my solution:

Sub AllFolderFiles()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim VBComp As VBComponent

Dim wb As Workbook
Dim TheFile As String
Dim MyPath As String
Dim VBCM As CodeModule
MyPath = "D:\Data\TrackerLayout"
ChDir MyPath
' Does an operation to all .xnv files in a folder
TheFile = Dir("*.xnv")
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)

' if the module called tracker already exists, delete it
If ModuleExists("Tracker") = True Then
Set VBComp = ActiveWorkbook.VBProject.VBComponents("Tracker")
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
End If

' add a module called tracker
Set VBComp =
ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = "Tracker"

' in the module called tracker, add the code from the text document
ModuleName = "Tracker"
ImportFromFile = "D:\data\tracker\pathtracker.txt"
Set VBCM = wb.VBProject.VBComponents(ModuleName).CodeModule
VBCM.AddFromFile ImportFromFile

' close the active workbook, and go to the next file in the folder

ActiveWorkbook.SaveAs FileName:=MyPath & "\" & TheFile,
FileFormat:=xlNormal _
, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False, _
CreateBackup:=False


wb.Close
TheFile = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

' tests to see if the module already exists

Function ModuleExists(ModuleName As String) As Boolean
On Error Resume Next
ModuleExists = Len( _
ActiveWorkbook.VBProject.VBComponents(ModuleName).Name) <> 0
End Function
 
Top