Could someone help me out, with this error? I am get an error number 5 in my code line 35 (ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Left(file.Name, InStrRev(file.Name, ".") - 1) The purpose of this code is to put in an excel sheet the name of all the folders and subfolders and files from a path given. It happens when it runs 33 times to copy the files from the same folder, so it gets to put data till row 60.
Sub Principal()
Call GetFiles("C:\Users\DGGC\Desktop\UNIR BOGC\")
End Sub
Sub GetFiles(ByVal path As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = fso.GetFolder(path)
Dim subfolder As Object
Dim file As Object
For Each subfolder In folder.SubFolders
GetFiles (subfolder.path)
Next subfolder
ActiveSheet.Cells(1, 1) = "File Path"
ActiveSheet.Cells(1, 2) = "Folder Name"
ActiveSheet.Cells(1, 3) = "File Name"
ActiveSheet.Cells(1, 4) = "File Extensions"
Dim i, o As Integer
'i = 1
'o = 1
Dim one, two As Long
one = Len(path) - 1
two = Len(Left(path, InStrRev(path, "\") - 1))
'two = Len(Left(file.Name, InStrRev(file.Name, ".") - 1))
ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, -1) = Right(path, one - two)
For Each file In folder.Files
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = path
ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Left(file.Name, InStrRev(file.Name, ".") - 1)
ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = Mid(file.Name, InStrRev(file.Name, ".") + 1)
Next file
Set file = Nothing
Set fso = Nothing
Set folder = Nothing
Set subfolder = Nothing
End Sub
Most likely you got the error because one of the file names didn't contain a dot. In that case InstrRev
returns 0 and the 2nd parameter of your Left
-statement will get -1
which is invalid in VBA.
Split such complex command into pieces - it helps you to identify errors.
Dim lastcell As Range
With ActiveSheet
Set lastcell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
Dim p As Long
p = InStrRev(file.name, ".")
If p > 0 Then
lastcell.Value = Left(file.name, p - 1)
lastcell.Offset(0, 1).Value = Mid(file.name, p + 1)
Else
lastcell.Value = file.name
lastcell.Offset(0, 1).Value = ""
End If
A FileSytemObject has methods GetBaseName and GetExtensionName
Option Explicit
Sub Principal()
Range("A1:D1") = Array("File Path", "Folder Name", "File Name", "File Extensions")
Call GetFiles("C:\Users\DGGC\Desktop\UNIR BOGC\")
End Sub
Sub GetFiles(ByVal path As String)
Dim fso As Object
Dim folder As Object, subfolder As Object, file As Object
Dim lastRow As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Cells(lastRow + 1, "B") = folder.Name
For Each file In folder.Files
lastRow = lastRow + 1
Cells(lastRow, "A") = path
Cells(lastRow, "C") = fso.getBaseName(file.Name)
Cells(lastRow, "D") = fso.getExtensionName(file.Name)
Next file
For Each subfolder In folder.SubFolders
GetFiles (subfolder.path)
Next subfolder
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.