How to Insert workbook name in all worksheets in first column of all rows (used rows) in a folder

Question

I have a task to add workbook name into all worksheet's first column hence i need to have a macro and below is a draft of the same

Sub InsertWorkbookName()
Path = "C:\Users\mechee69\Download\"
Filename = Dir(Path & "*.xls")

Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Application.Goto Range("A" & ActiveCell.Row), True
ActiveCell.Select
ActiveCell.FormulaR1C1 = _
    "=RIGHT(LEFT(CELL(""filename""),FIND(""."",CELL(""filename""),FIND(""["",CELL(""filename""),1))-1),FIND(""."",CELL(""filename""),FIND(""["",CELL(""filename""),1))-FIND(""["",CELL(""filename""),1)-1)"
Application.Goto Range("A" & ActiveCell.Row), True
ActiveCell.Select
Selection.Copy
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Wouldn't it be easier to just set the Value to `Path & Filename` rather than a complicated formula and series of copy / pastes? — YowE3K, May 18 '17 at 04:45
@YowE3K : Thanks. This script requires lot of changes I guess. It do not run completely on all files due to some unknown reasons it fail to function on some files. Any help regarding making it shorter and accurate will be appreciated. I am new to VBA and this code was written using record macro feature. Please support by editing the macro as suitable. Thanks again. — mechee69, May 18 '17 at 05:35

score 0 · Answer 1 · edited May 23 '17 at 12:34

Try this

Sub WorkbookName()
Dim wbk As Workbook
Dim strFilename As String
Dim strPath As String
Dim wc As Worksheet
Dim lngLastR As Long
Dim lngSecurity as Long

lngSecurity = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityLow    
strPath = "[Full Folder Path]"
strFilename = Dir(strPath & "*.xlsx")

Do While strFilename <> ""
    Set wbk = Workbooks.Open(strPath & strFilename)
    For Each ws In wbk.Worksheets
        lngLastR = ws.Range("A" & Rows.Count).End(xlUp).Row
        ws.Range("A:A").Insert Shift:=xlToRight
        ws.Range("A1:A" & lngLastR).Value = wbk.Name
    Next
    wbk.Save
    wbk.Close False
    strFilename = Dir

Loop
Application.AutomationSecurity = lSecurity
MsgBox ("Done")
End Sub

As a quick run through of what this code does.

'Dir' goes through a folder on a criteria, the criteria in this case being ".xlsx" this is to make sure it only opens xlsx files.

'Do While' is a form of loop, this will repeat all code between the "Do While" and the "Loop" until the condition is no longer true.

Once deciding on the file it opens the workbook and remembers it as a variable, this is so I can reference it's name more easily.

I then find the last used row by starting at the bottom cell of row "A" and going up until there is data in a cell. There is a write up on this on stack overflow (Link: Error in finding last used cell in VBA)

I then insert a row to the left pushing the data to the right and set the value of all cells in row 'A' in the used ranged to the name of the workbook using the workbooks '.Name' function.

I then save and close the workbook before using the 'Dir' to the next file name ready to start the process again, this will repeat for all files and give you a message box saying "Done" once it has completed them all.

If you have any questions let me know

Edited to include a bypass for protected view

I realized that this macro skips those while which gives below warning while opening; "Protected View-Office has detected a problem with this file. Editing it may harm your computer. Click more for details". Please support as i need to include these files as well — mechee69, May 18 '17 at 11:31
@mechee69 I have edited it to bypass the protected view. The how to can be found here: http://stackoverflow.com/questions/25889742/remove-protected-view-from-excel-sheet-opened-programmatically-in-access — Hocus, May 18 '17 at 12:36

Plagon · Accepted Answer · 2017-05-18T10:53:07.417

-1

So this Macro will open Excel Files in a Folder with a specific format, then it prints the workbookname in A1 in every sheet of that file. It ignores the master, if its in the same folder.

Sub WorkbookName()
Dim wbk As Workbook
Dim Filename As String
Dim Path As String
Dim lastRow As Long
Dim lSecurity As Long

On Error Resume Next

Path = "C:\Users\User\Desktop\Files\" 'Folder of your Files
Filename = Dir(Path & "*.xlsx") 'Format of your files

Do While Filename <> "" And Filename <> "Master.xlsm" 'Dont Open MasterFile
    Set wbk = Workbooks.Open(Path & Filename)
    lSecurity = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityLow

    For Each ws In wbk.Worksheets
        With ws
            .Range("A1").EntireColumn.Insert
            lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
            .Range(Cells(1, 1), Cells(lastRow, 1)).Value = ActiveWorkbook.Name

        End With
    Application.AutomationSecurity = lSecurity
    Next ws
wbk.Close True
Filename = Dir
Loop
End Sub

edited May 18 '17 at 10:53

answered May 18 '17 at 06:23

Plagon

2,689
1
11
23

thanks for your code. I tried it worked on few files and then gave me an error. My requirements are 1) As my data already has info in cell A1 hence what suits the need is to insert a column and then insert workbookname. 2) I want the workbook name in the column A of all used rows not just first row of every worksheets. Thanks. – mechee69 May 18 '17 at 07:15
What was the error you got? i can fix it, but i need more informations. – Plagon May 18 '17 at 07:22
It did not work on a file which was giving warning prior to opening the file (Internet downloaded file). Later it worked on it. Thanks. But the code do not meet my request as i require name in column A of all the rows and should not overwrite existing data as my data already has information in column A and I have more than 50 such files in the folder. – mechee69 May 18 '17 at 07:28
I realized that this macro skips those while which gives below warning while opening; "Protected View-Office has detected a problem with this file. Editing it may harm your computer. Click more for details". Please support as i need to include these files as well. – mechee69 May 18 '17 at 10:20
Try this version, otherwise turn off protected view in settings: https://medium.com/lets-excel/microsoft-excel-how-to-disable-protected-view-in-ms-excel-ae01a0c5405b and reenable after you are done, if u even need it. – Plagon May 18 '17 at 10:53
thanks. I tried both option. Still facing the same problem. Please help. – mechee69 May 18 '17 at 11:30
So in the trustcenter settings you can add trusted folders, add your folder and it will work. the settings apply only to new files. i didnt knew that. – Plagon May 18 '17 at 12:34
@UGP I think the reason you're code still opens it in protected view is you turn off the security setting after the file is open already instead of before you open the file, but I'm not 100% sure. – Hocus May 18 '17 at 12:38
@Hocus that could be possible. I had no chance to testit. If he just add his folder to the trusted locations its the easiest solution and this post is closed. – Plagon May 18 '17 at 12:44
@UGP It worked by adding folder to trusted location. Thanks a ton UGP and Hocus.. – mechee69 May 18 '17 at 12:49

How to Insert workbook name in all worksheets in first column of all rows (used rows) in a folder

2 Answers2