1

Just another question hopefully someone can help me with.

For those who have helped me in the past I greatly appreciate this community and I am glad to be apart of it.

Here's some background info.

I have created ~3200 excel Workbooks off a master list (theFILE 1.1.xlsm) each workbook was compiled from a line on the master list.

Now I've been able to edit sheets and cells using this code;

Sub Macro2() Application.ScreenUpdating = False Dim sFile As String Dim wb As Workbook Dim FileName1 As String Dim FileName2 As String Dim wksSource As Worksheet Const scWkbSourceName As String = "theFILE 1.1.xlsm" Set wkbSource = Workbooks(scWkbSourceName) Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name Const wsOriginalBook As String = "theFILE 1.1.xlsm" Const sPath As String = "E:\theFILES\" SourceRow = 5 Do While Cells(SourceRow, "D").Value <> "" FileName1 = wksSource.Range("A" & SourceRow).Value FileName2 = wksSource.Range("K" & SourceRow).Value sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm" 'Open Source Row's File Set wb = Workbooks.Open(sFile) '(INSERT CODE FOR SPECIFIED JOB) 'CLOSE WORKBOOK W/O BEFORE SAVE Application.EnableEvents = False ActiveWorkbook.Save ActiveWorkbook.Close Application.EnableEvents = True SourceRow = SourceRow + 1 ' Move down 1 row for source sheet Loop End Sub 

Please bear with my lack of terminology.

I would like to be able to use this code if possible to open each Workbook and edit lines within the 'Microsoft Excel Objects' - 'ThisWorkbook'. This module, if you can call it that, houses a BeforeSave Function which logs some info on a hidden spreadsheet every time a user saves.

Here is the Current 'BeforeSave' Macro

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim ws As Worksheet Set ws = Sheets("EDITS") Dim tbl As ListObject Set tbl = ws.ListObjects("Table1") Dim newrow As ListRow Set newrow = tbl.ListRows.Add SavePrompt.Show With newrow .Range(1) = Now .Range(2) = SavePrompt.TextBox1.Text End With Unload SavePrompt End Sub 

I need to add .Range(3)=Computer Name and .Range(4)=username to this. I need each Workbook to work stand-alone as host computers may change sporadically and others won't be able to re-link or edit the VBAs.

First is it possible to edit 'Microsoft Excel Objects - ThisWorkbook'

If so how? I've tried ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 13, "Test"

...After allowing Excel to "Trust access to the VBA project object model", I received a notification stating, "Can't enter break mode at this time", I selected "Continue" and My computer didn't like the code while it did open and close each Workbook like normal. It ended up adding "Test" to the Master's "ThisWorkbook". The master Workbook (theFILE 1.1.xlsm) doesn't have a Macro in there so it just added to the next available line from the looks of it.

I then changed the last Code to;

ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 13, "Test" 

This seemed to solve the errors but as the computer runs the code it starts getting hung up and Excel starts begins to appear to "Not Respond.."

So if this is possible... Is it possible to add/insert a line and move the preceding lines down 1 as it is done in excel when right clicking on a row?

If Excel doesn't allow editing of lines in 'ThisWorkbook' then how do I completely overhaul the Object? (delete and import updated object)

7
  • 3
    Please, check this answer. It's not exactl what you want, but it explains how to edit VBA code with VBA itself. Just adapt it to your needs. Commented Sep 13, 2018 at 13:45
  • 2
    "not responding" is just your code being busy. You could probably get Excel responding again by adding DoEvents just before closing the Loop, but then that will probably make it slower to complete. Now, how do you know the line you want to insert at is line 13? Better locate the procedure you want to replace, find its starting+ending line, and replace these lines (whatever they are) with your new code. First step is to put a breakpoint at Loop, and verify that your code is doing what it needs to do, before wrecking 3000 files in one go ;-) Commented Sep 13, 2018 at 14:28
  • 2
    ThisWorkbook (the identifier) will always refer to the workbook that's currently running the code you're looking at. "ThisWorkbook" (the component name) refers to the "ThisWorkbook" VBComponent of the parent VBProject. That's why you couldn't enter break mode (the code in this workbook was modified, and hadn't had a chance to recompile yet), and why getting the VBProject reference off ActiveWorkbook worked. That said wb.VBProject would be much safer. Commented Sep 13, 2018 at 14:32
  • Thanks for your Feedback @MathieuGuindon , and after i restarted my machine it ran fine. but it appears that the lines that were already occupied the space and the VBA put the value on the next available line. Is this normal. If so, how do i delete two specific lines so I can have everything in procedural order? Commented Sep 13, 2018 at 15:11
  • 2
    Reference the Visual Basic Extensibility type library, and declare typed local variables instead of chaining member calls 5 layers deep - you'll get intellisense to guide you. e.g. declare currentProject As VBProject, then wbComponent As VBComponent, and wbModule As CodeModule; assign each one, then see what members wbModule has - you'll find methods to locate specific procedures, what line they start at, and how many lines they are. Commented Sep 13, 2018 at 15:16

1 Answer 1

1
Sub Macro2() '''EDIT THE MACRO ON "ThisWorkbook" MODULE Application.ScreenUpdating = False Dim sFile As String Dim wb As Workbook Dim FileName1 As String Dim FileName2 As String Dim wksSource As Worksheet Const scWkbSourceName As String = "theFILE 1.1.xlsm" Set wkbSource = Workbooks(scWkbSourceName) Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name Const wsOriginalBook As String = "theFILE 1.1.xlsm" Const sPath As String = "E:\theFILES\" 'this is PATH(!REMEMBER! to include "\") SourceRow = 5 Do While Cells(SourceRow, "D").Value <> "" FileName1 = wksSource.Range("A" & SourceRow).Value FileName2 = wksSource.Range("K" & SourceRow).Value sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm" Set wb = Workbooks.Open(sFile) '''EDIT THE MACRO ON "ThisWorkbook" MODULE - FOR EACH PLANT's Workbook 'Deleting Lines ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 27 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 25 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 21 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 19 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 18 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 17 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 16 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 12 ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.deleteLines 10 'Add DIM Lines ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 10, "'DIM SOME MORE OBJECTS" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 11, "Dim computername As String" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 12, "Dim username As String" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 13, "computername = Environ(""computername"")" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 14, "username = Environ(""username"")" 'Add the Lines Back ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 16, " SavePrompt.Show" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 17, "'If SavePrompt.TextBox1 > 0 Then" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 18, "With newrow" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 19, " .Range(1) = Now" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 20, " .Range(2) = SavePrompt.TextBox1.Text" 'Add New Range LINES ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 21, " .Range(3) = computername" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 22, " .Range(4) = username" 'Continue Adding Lines back ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 24, "End With" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 25, "'ElseIf" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 26, "Unload SavePrompt" ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.insertLines 28, "End Sub" '''CLOSE WORKBOOK W/O BEFORE SAVE Application.EnableEvents = False ActiveWorkbook.Save ActiveWorkbook.Close Application.EnableEvents = True SourceRow = SourceRow + 1 Loop End Sub 
Sign up to request clarification or add additional context in comments.

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.