有人可以幫我解決這個錯誤嗎？我的代碼行 35 (ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Left(file.Name, InStrRev(file.Name, ". ") - 1) 此代碼的目的是將給定路徑中所有檔案夾、子檔案夾和檔案的名稱放入 Excel 作業表中。當它運行 33 次以從同一檔案夾復制檔案時會發生這種情況，所以它將資料放到第 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
uj5u.com熱心網友回復：
很可能您收到錯誤是因為其中一個檔案名不包含點。在這種情況下，InstrRev回傳 0 并且您的Left-statement 的第二個引數將-1在 VBA 中無效。
將如此復雜的命令拆分為多個部分 - 它可以幫助您識別錯誤。
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
uj5u.com熱心網友回復：
FileSytemObject 具有GetBaseName和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
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/417848.html
標籤：
下一篇：ExcelVBA根據標題組合列