I'm writting a VBA Macro in Excel that should o the following:
- Given a following path loops through the subfolders in that path (all subfolders begin with a sequencial number)
- Goes inside the subfolder which are in a numerical window defined as input (Start_i=76, Finish_i=106 for instance) and searches for the excel file (.xlsx or .xlsm) which has the same name as that subfolder
- Open it, change some specifc cells, saves and close the file
- Proccede to the next subfolder in the window [76, 106]
So far so good.
Problem, I have a folder with 2 files (.pdf and .xlxs) and teh program returs my 3 files (.pdf and 2x .xlxs)
Option Explicit
Sub BaKo_Check()
Dim Name As String, Fa As String, Anlage As String, projekt As String, auxStringPath As String
Dim Datum As Date
Dim BeMi As Integer, Start_i As Integer, Finish_i As Integer, BaKo_Nr As Integer
Dim FSO As New FileSystemObject
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim file As Object
Dim fileName As String
'Get Data from Input Window
Fa = Range("I2").Text
projekt = Range("I3").Text
Name = Range("I4").Text
Datum = Range("I5").Value
Start_i = ThisWorkbook.Sheets("Sheet1").Range("I10").Value
Finish_i = ThisWorkbook.Sheets("Sheet1").Range("I11").Value
auxStringPath = Range("I8").Text
'Error Control
If auxStringPath = "" Then
Err = 19
GoTo handleCancel
End If
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(auxStringPath)
'Loop through subfolders in main Folder
For Each objSubFolder In objFolder.subfolders
BaKo_Nr = CInt(Left(objSubFolder.Name, 3))
If BaKo_Nr >= Start_i Then
If BaKo_Nr <= Finish_i Then
'Loop trough Files in SubFolders
For Each file In objSubFolder.Files
fileName = FSO.getfilename(CStr(file))
If FSO.GetExtensionName(CStr(file)) = "xlsx" Or FSO.GetExtensionName(CStr(file)) = "xlsm" Then
Workbooks.Open fileName:=file
Workbooks(fileName).Sheets("BaKo_neu").Range("C4").Value = projekt
Workbooks(fileName).Sheets("BaKo_neu").Range("C53").Value = Name
Workbooks(fileName).Sheets("BaKo_neu").Range("C54").Value = Datum
Workbooks(fileName).Sheets("BaKo_neu").Range("H2").Value = Fa
Workbooks(fileName).Sheets("BaKo_neu").Range("H4").Value = Mid(fileName, 10, 6)
ThisWorkbook.Sheets("Sheet1").Range("E23").Value = Mid(fileName, 10, 6)
Workbooks(fileName).Sheets("BaKo_neu").Range("C2").Value = ThisWorkbook.Sheets("Sheet1").Range("F23").Value
Workbooks(fileName).Save
Workbooks(fileName).Close
End If
Next file
End If
End If
Next objSubFolder
handleCancel:
If Err = 19 Then
MsgBox "Missing Path"
End If
End Sub
The code function for the 1st and 2nd files, but when it goes to the 3rd it crashes...
Can someone help me out? Many Thanks