简体   繁体   中英

how to fix an error number 5 in vba excel

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM