Vishal302019
New Member
- Joined
- Sep 2, 2020
- Messages
- 1
- Office Version
- 2010
- Platform
- Windows
Public rowIndex As Long
Sub MainProc()
Dim DirName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
rowIndex = 2
DirName = Sheets("Macro").Range("B4").Value
Sheets("Macro").Range("H2:M200000").Clear
Sheets("Macro").Range("H1:M200000").Columns.AutoFit
If DirName = "" Then
MsgBox "Please provide valid Folder Name", vbCritical, "Error"
End
End If
If Dir(DirName, vbDirectory) = "" Then
MsgBox "Please provide valid Folder Name", vbCritical, "Error"
End
End If
Call ListFilesInFolder(DirName, True)
Sheets("Macro").Range("H1:M" & rowIndex).Select
Selection.Borders.LineStyle = xlContinuous
Selection.Borders.Weight = xlThin
Selection.Columns.AutoFit
Range("H2").Select
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
For Each xFile In xFolder.Files
Sheets("Macro").Cells(rowIndex, 8).Value = rowIndex - 1
Sheets("Macro").Cells(rowIndex, 9).Value = xFolder
Sheets("Macro").Cells(rowIndex, 10).Value = xFile.Name
Sheets("Macro").Cells(rowIndex, 11).Value = "File"
Sheets("Macro").Cells(rowIndex, 12).Value = xFile.DateCreated
Sheets("Macro").Cells(rowIndex, 13).Value = xFile.DateLastModified
rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.SUBFOLDERS
Sheets("Macro").Cells(rowIndex, 8).Value = rowIndex - 1
Sheets("Macro").Cells(rowIndex, 9).Value = xFolder
Sheets("Macro").Cells(rowIndex, 10).Value = xSubFolder.Name
Sheets("Macro").Cells(rowIndex, 11).Value = "Subfolder"
Sheets("Macro").Cells(rowIndex, 12).Value = xSubFolder.DateCreated
Sheets("Macro").Cells(rowIndex, 13).Value = xSubFolder.DateLastModified
rowIndex = rowIndex + 1
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
Private Sub cmdclearsheet_Click()
Sheets("Macro").Range("B4").Value = ""
Sheets("Macro").Range("H2:M200000").Clear
Sheets("Macro").Range("H1:M200000").Columns.AutoFit
Range("B4").Select
End Sub
Private Sub cmdgetinfo_Click()
Call MainProc
End Sub
Sub MainProc()
Dim DirName As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
rowIndex = 2
DirName = Sheets("Macro").Range("B4").Value
Sheets("Macro").Range("H2:M200000").Clear
Sheets("Macro").Range("H1:M200000").Columns.AutoFit
If DirName = "" Then
MsgBox "Please provide valid Folder Name", vbCritical, "Error"
End
End If
If Dir(DirName, vbDirectory) = "" Then
MsgBox "Please provide valid Folder Name", vbCritical, "Error"
End
End If
Call ListFilesInFolder(DirName, True)
Sheets("Macro").Range("H1:M" & rowIndex).Select
Selection.Borders.LineStyle = xlContinuous
Selection.Borders.Weight = xlThin
Selection.Columns.AutoFit
Range("H2").Select
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
For Each xFile In xFolder.Files
Sheets("Macro").Cells(rowIndex, 8).Value = rowIndex - 1
Sheets("Macro").Cells(rowIndex, 9).Value = xFolder
Sheets("Macro").Cells(rowIndex, 10).Value = xFile.Name
Sheets("Macro").Cells(rowIndex, 11).Value = "File"
Sheets("Macro").Cells(rowIndex, 12).Value = xFile.DateCreated
Sheets("Macro").Cells(rowIndex, 13).Value = xFile.DateLastModified
rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.SUBFOLDERS
Sheets("Macro").Cells(rowIndex, 8).Value = rowIndex - 1
Sheets("Macro").Cells(rowIndex, 9).Value = xFolder
Sheets("Macro").Cells(rowIndex, 10).Value = xSubFolder.Name
Sheets("Macro").Cells(rowIndex, 11).Value = "Subfolder"
Sheets("Macro").Cells(rowIndex, 12).Value = xSubFolder.DateCreated
Sheets("Macro").Cells(rowIndex, 13).Value = xSubFolder.DateLastModified
rowIndex = rowIndex + 1
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
Private Sub cmdclearsheet_Click()
Sheets("Macro").Range("B4").Value = ""
Sheets("Macro").Range("H2:M200000").Clear
Sheets("Macro").Range("H1:M200000").Columns.AutoFit
Range("B4").Select
End Sub
Private Sub cmdgetinfo_Click()
Call MainProc
End Sub