Không chạy được đoạn code dưới khi copy vào file excel khác???? (1 người xem)

[toantinhte87]

Đây là 1 đoạn code của các bạn trên diễn đàn. Nhưng khi mình copy qua file khác thì Không chạy được đoạn code dưới khi copy vào file excel khác????
===================================
Option Explicit
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
On Error GoTo ExitSub
With New Scripting.FileSystemObject
For Each FileItem In .GetFolder(FolderName).Files
If .GetExtensionName(FileItem.Path) = "xls" Then
With Range("A65536").End(xlUp)
With .Offset(1, 0)
.Value = FileItem.Path
.Parent.Hyperlinks.Add .Cells, .Value
End With
.Offset(1, 1) = FileItem.Size
.Offset(1, 2) = FileItem.DateCreated
.Offset(1, 3) = FileItem.DateLastModified
End With
End If
Next FileItem
If InSub Then
For Each SubFolder In .GetFolder(FolderName).SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
End With
ExitSub:
End Sub
Sub GetFileList()
On Error GoTo ExitSub
Sheet1.Select
Range("A260000").ClearContents
With Application.FileDialog(4)
.Show: .AllowMultiSelect = False
ListFilesInFolder .SelectedItems(1), True
End With
Columns("A:E").AutoFit
ExitSub:
End Sub

 

[quanluu]

Đây là 1 đoạn code của các bạn trên diễn đàn. Nhưng khi mình copy qua file khác thì Không chạy được đoạn code dưới khi copy vào file excel khác????
===================================
Option Explicit
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
On Error GoTo ExitSub
With New Scripting.FileSystemObject
For Each FileItem In .GetFolder(FolderName).Files
If .GetExtensionName(FileItem.Path) = "xls" Then
With Range("A65536").End(xlUp)
With .Offset(1, 0)
.Value = FileItem.Path
.Parent.Hyperlinks.Add .Cells, .Value
End With
.Offset(1, 1) = FileItem.Size
.Offset(1, 2) = FileItem.DateCreated
.Offset(1, 3) = FileItem.DateLastModified
End With
End If
Next FileItem
If InSub Then
For Each SubFolder In .GetFolder(FolderName).SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
End With
ExitSub:
End Sub
Sub GetFileList()
On Error GoTo ExitSub
Sheet1.Select
Range("A260000").ClearContents
With Application.FileDialog(4)
.Show: .AllowMultiSelect = False
ListFilesInFolder .SelectedItems(1), True
End With
Columns("A:E").AutoFit
ExitSub:
End Sub

Bạn sửa lại với 3 dòng như sau:

Dim FileItem As Object, SubFolder As Object, FileName As String
On Error GoTo ExitSub
With CreateObject("Scripting.FileSystemObject")

 

[toantinhte87]

Bạn sửa lại với 3 dòng như sau:

Dim FileItem As Object, SubFolder As Object, FileName As String
On Error GoTo ExitSub
With CreateObject("Scripting.FileSystemObject")

Minh chay duoc roi ban! cam on ban nhieu!