Public Sub Now_GetFileProperties()
Dim objFS As Object
Dim objFile As Object
Dim strPath As String
Dim vFile As Variant
Dim iCurRow As Integer
strPath = ActiveSheet.Range("A3").Value
If Right(strPath, 1) <> "/" And Right(strPath, 1) <> "" Then
strPath = strPath & ""
End If
ChDir strPath
vFile = Dir(strPath & "*.*")
Set objFS = CreateObject("Scripting.FileSystemObject")
iCurRow = 7
Do While vFile <> ""
Set objFile = objFS.GetFile(vFile)
ActiveSheet.Cells(iCurRow, 3).Value = objFile.Name
ActiveSheet.Cells(iCurRow, 4).Value = objFile.DateCreated
ActiveSheet.Cells(iCurRow, 5).Value = objFile.DateLastAccessed
ActiveSheet.Cells(iCurRow, 6).Value = objFile.DateLastModified
ActiveSheet.Cells(iCurRow, 7).Value = Round(objFile.Size / 1024 / 1024, 2)
ActiveSheet.Cells(iCurRow, 8).Value = objFile.Type
vFile = Dir
iCurRow = iCurRow + 1
Loop
End Sub
Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A1048574").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Path
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastModified
r = r + 1
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
End Sub
Sub macro12_run_all_copy_paste_files_()
Application.DisplayAlerts = False
Application.Run " Macro18"
Application.Run " Macro20"
Application.Run " Macro21"
Application.Run " Macro22"
Application.Run " Macro23"
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R1C2"
For i = 1 To Range("a2")
Application.Run " Macro29"
Application.Run " Macro30"
Application.Run " Macro31"
Next
End Sub
Sub Macro18()
Windows("Master.xlsm").Activate
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R3C1"
Selection.Copy
Application.Goto Reference:="R3C27"
ActiveSheet.Paste
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R1C1"
ActiveCell.Columns("A:Z").EntireColumn.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Application.Goto Reference:="R1C1"
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Run "Now_GetFileProperties"
Application.Goto Reference:="R1C1"
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
End Sub
Sub Macro20()
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R999999C3"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Clear
Selection.FormulaR1C1 = "=ROW()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Cut
Application.Goto Reference:="R1C1"
ActiveSheet.Paste
Application.Goto Reference:="R2C1"
Selection.FormulaR1C1 = "=R[-1]C-7"
End Sub
Sub Macro21()
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R7C2"
Selection.FormulaR1C1 = "=R3C1&RC[1]"
Selection.Copy
Selection.Copy
ActiveCell.Range("A1:A" & Range("a2")).Select
ActiveSheet.Paste
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Sub Macro22()
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R1C2"
Selection.End(xlDown).Select
Selection.Copy
Application.Goto Reference:="R7C2"
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Range("A1:A" & Range("a2")).Select
Application.CutCopyMode = False
Selection.Copy
Application.Goto Reference:="R7C1"
ActiveSheet.Paste
End Sub
Sub Macro23()
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R1C1"
ActiveCell.Columns("A:Z").EntireColumn.Select
Selection.Columns.AutoFit
Application.Goto Reference:="R1C1"
End Sub
Sub Macro29()
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.DisplayAlerts = False
Application.Goto Reference:="R1C2"
Selection.End(xlDown).Select
Selection.Cut
Application.Goto Reference:="R1C2"
ActiveSheet.Paste
Workbooks.Open Filename:=Range("b1")
ActiveWorkbook.SaveAs Filename:="C:\temp2\6489\temp_delete_me.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Sub Macro30()
Windows("temp_delete_me.xlsx").Activate
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 1).Range("A1").Select
Selection.Clear
Selection.FormulaR1C1 = "=COLUMN()"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=ROW()"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Range("A1:B1").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Cut
Application.Goto Reference:="R1C2"
ActiveSheet.Paste
Selection.Copy
Application.Goto Reference:="R1C3"
Application.CutCopyMode = False
Selection.Copy
Application.Goto Reference:="R1C1"
ActiveSheet.Paste
End Sub
Sub Macro31()
Application.DisplayAlerts = False
Windows("temp_delete_me.xlsx").Activate
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R2C1"
ActiveCell.Rows("1:" & Range("a1") - 1).EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Master.xlsm").Activate
Sheets("MasterSheet").Select
Application.Goto Reference:="R999999C1"
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.Goto Reference:="R1C1"
Windows("temp_delete_me.xlsx").Activate
ActiveWindow.Close
End Sub