Code To Open Files Within Folder And Insert A Column With Header And Close

[Dazzawm]

I need a code please that will open some files within a folder and insert a column in AD with a header of Eurostd and close and save.

Is this possible please? Thanks

 

[Norie]

Is it 'some' or all files in the folder?

Also, which sheet(s) should the column be inserted in?

 

[Dazzawm]

It is all and they are all sheet 1. There are some before close codes in them also so they are .xlsm files.

 

[Norie]

Perhaps something like this then.

Dim wb As Workbook
Dim FSO As Object
Dim fld As Object
Dim fl As Object
Dim strPath As String

    strPath = "C:\test\" ' change path as required

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder(strPath)
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each fl In fld.Files
        If Right(fl, 4) = ".xlsm" Then
            Set wb = Workbooks.Open(fl.Path)
            wb.Sheets(1).Range("AD:AD").EntireColumn.Insert xlShiftToRight
            wb.Sheets(1).Range("A1").Value = "Eurostd"
            wb.Close SaveChanges:=True
        End If
    Next fl

    Application.EnableEvents = True
    Application.ScreenUpdating = False

 

[Dazzawm]

Thanks where do I put this code? There is no start or end sub?

 

[Norie]

You can add your own, for example.

Sub InsertEurostdCol()

Dim wb As Workbook
Dim FSO As Object
Dim fld As Object
Dim fl As Object
Dim strPath As String

    strPath = "C:\test\" ' change path as required

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder(strPath)
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each fl In fld.Files
        If Right(fl, 4) = ".xlsm" Then
            Set wb = Workbooks.Open(fl.Path)
            wb.Sheets(1).Range("AD:AD").EntireColumn.Insert xlShiftToRight
            wb.Sheets(1).Range("A1").Value = "Eurostd"
            wb.Close SaveChanges:=True
        End If
    Next fl

    Application.EnableEvents = True
    Application.ScreenUpdating = False

End Sub

 

[Dazzawm]

I get an error 76 path not found and points to this line?

Set fld = FSO.GetFolder(strPath)

 

[Dazzawm]

Actually my fault typo in path, but it did run and did nothing?

I have just opened a blank sheet and inserted code in my PMW. But didn't do a thing when run.

 

[Norie]

Think there was a typo in what I copied into my post, try this.

Sub InsertEurostdCol()

Dim wb As Workbook
Dim FSO As Object
Dim fld As Object
Dim fl As Object
Dim strPath As String

    strPath = "C:\test\" ' change path as required

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder(strPath)
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each fl In fld.Files

        If Right(fl.Name, 4) = ".xlsm" Then

            Set wb = Workbooks.Open(fl.Path)
            wb.Sheets(1).Range("AD:AD").EntireColumn.Insert xlShiftToRight
            wb.Sheets(1).Range("A1").Value = "Eurostd"
            wb.Close SaveChanges:=True
        End If
    Next fl

    Application.EnableEvents = True
    Application.ScreenUpdating = False

End Sub

 

[Dazzawm]

Sorry still does nothing. No errors or anything, just nothing?