Pfthb

I have made code that needs to do the following:

1. scan directory op.xlsx file #please review


2. open file activate sheet "Buitendelen" (some files don't have so skip file and go on)


3. if sheet "buitendelen" is activated add new column between C and D


4. save file


5. close file


6. go on to next file

It sometimes does not work or it crashes after some time editing files.

Sub AllFiles_click()
 '//Change the path to the main folder, accordingly
 Call RecursiveFolders("C:testlabtestmap")
End Sub

Sub RecursiveFolders(ByVal MyPath As String)

 Dim FileSys As Object
 Dim objFolder As Object
 Dim objSubFolder As Object
 Dim objFile As Object
 Dim wkbOpen As Workbook

 Set FileSys = CreateObject("Scripting.FileSystemObject")
 Set objFolder = FileSys.GetFolder(MyPath)

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False

 'open every folder and subfolder
 For Each objSubFolder In objFolder.SubFolders

 'search for file in folder and subfolder
 For Each objFile In objSubFolder.Files

 'set open workbook
 Set wkbOpen = Workbooks.Open(filename:=objFile)

 'call passwordfirst code to unlock sheets
 Call passwordfirst

 'activated sheet buitendelen
 wkbOpen.Sheets("Buitendelen").Activate

 'call columnadd code to add column
 Call columnadd

 'close workbook and save
 wkbOpen.Close savechanges:=True
 Next

 'start over again
 Call RecursiveFolders(objSubFolder.Path)

 Next

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True
End Sub

'code to unlock sheets with password
Sub passwordfirst()
 ActiveSheet.Unprotect Password:="Freonr410a"
End Sub

'code to add column
Private Sub columnadd()
 Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

I saw couple of things regarding your code and question. First off, line:

ActiveSheet.Unprotect Password:="Freonr410a"

This line, sometimes might cause some issues because, your first active sheet, after you open particular workbook, might not be the Buitendelen worksheet. You are depending on someone (or yourself) to close workbook with this sheet active (tricky thing).

This line:

Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

... might also be a root of some problems if it comes to adding new columns. Image that your first worksheet isn't Buitendele worksheet. You can successful unlock unprotected worksheet, but now you are trying to add new column to completely different worksheet. Unacceptable.

I saw also that you are omitting any files (except folders) inside your root folder ("C:testlabtestmap"). That means, if you have any files inside TestMap folder, they will be left untouched. I don't know if this is desired thing or not.

Here, you can find a solution for your problem (tested on W10/ Excel 2017 32 bit)

Sub AllFiles_click()
 Call RecursiveFolders("C:testlabtestmap")
End Sub

' Go through every folder starting from objFolder
' location recursively and add one column after column D
' inside workbook. If Buitendelen worksheet does not exists,
' go to next workbook.
Sub RecursiveFolders(ByVal MyPath As String)
 Const BuitendelenWsName as String = "Buitendelen"

 Dim FileSys As Object
 Dim objFolder As Object
 Dim objSubFolder As Object
 Dim objFile As Object
 Dim wkbOpen As Workbook
 Dim wshToEdit as Worksheet

 Set FileSys = CreateObject("Scripting.FileSystemObject")
 Set objFolder = FileSys.GetFolder(MyPath)

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False

 For Each objSubFolder In objFolder.SubFolders
 For Each objFile In objSubFolder.Files
 Set wkbOpen = Workbooks.Open(filename:=objFile)

 If SheetExists(BuitendelenWsName, wkbOpen) Then
 Set wshToEdit = wkbOpen.Worksheets(BuitendelenWsName)

 ' Before any changes, worksheet has to be unprotected.
 wshToEdit.Unprotect Password:="Freonr410a"
 wshToEdit.Columns("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
 End if

 wkbOpen.Close savechanges:=True
 Next
 Call RecursiveFolders(objSubFolder.Path)
 Next

 Application.ScreenUpdating = True
 Application.DisplayAlerts = True

 set FileSys = nothing
 set objFolder = nothing
 set objSubFolder = nothing
 set objFile = nothing
 set wkbOpen = nothing
 set wshToEdit = nothing
End Sub

Public Function SheetExists(byval sheetToFind As String, byref container as Workbook) As Boolean
 Dim sht as Worksheet

 SheetExists = False
 For Each sht In container.Worksheets
 If sheetToFind = sht.name Then
 SheetExists = True
 Exit For
 End If
 Next sht 

 set sht = nothing
End Function

Extra notes: Please, work on your naming conventions, AllFiles or RecursiveFolders tells nothing about the body of subroutines.

Variable naming conventions: Be precise, if you are going to use Hungarian notation use it - FileSys should be changed to objFileSys.