'This function loops through all the files in the folder and gets the properties of each file and displays them on the sheet
Public Sub Now_GetFileProperties()
'Variable Declaration
Dim objFS As Object
Dim objFile As Object
Dim strPath As String
Dim vFile As Variant
Dim iCurRow As Integer
'Clear old data from the sheet
'' Sheet1.Range("C7:H" & Sheet1.Rows.Count).ClearContents
'Set the path of the folder based on cell A3
strPath = ActiveSheet.Range("A3").Value
' ====> manually set the path below strPath = "c:\temp2\6489\"
'Add slash at the end of the path
If Right(strPath, 1) <> "/" And Right(strPath, 1) <> "" Then
strPath = strPath & ""
End If
'Set Directory to folder path
ChDir strPath
vFile = Dir(strPath & "*.*") 'Change or add formats to get specific file types
'Set the variable to FileSystemObject
Set objFS = CreateObject("Scripting.FileSystemObject")
iCurRow = 7
Do While vFile <> "" 'LOOP until all files in folder strPath have been looped through
Set objFile = objFS.GetFile(vFile)
'File name
ActiveSheet.Cells(iCurRow, 3).Value = objFile.Name
'Date Created
ActiveSheet.Cells(iCurRow, 4).Value = objFile.DateCreated
'Date Last Accessed
ActiveSheet.Cells(iCurRow, 5).Value = objFile.DateLastAccessed
'Date Last Modified
ActiveSheet.Cells(iCurRow, 6).Value = objFile.DateLastModified
'Size
ActiveSheet.Cells(iCurRow, 7).Value = Round(objFile.Size / 1024 / 1024, 2)
'Type
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)
'Declaring variables
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
'Creating object of FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A1048574").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
'Display file properties
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
'Getting files in sub folders
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
'Calling same procedure for sub folders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
'''go to the sheet ListFiles
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
End Sub
'''assume the following. you have all the csv files in this folder C:\temp2\6489
''' the master file is named Master.xlsm inside are two sheets ListFiles, and MasterSheet
''' ListFiles is where all the csv files are listed.
''' MasterSheet is where all the data will be copied to.
''' When copying, will not copy row1, as row1 is assumed to be the header
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()
'
'''go to the sheet ListFiles
Windows("Master.xlsm").Activate
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
'copy your path from A3 to AA3, so A to Z can be deleted
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R3C1"
Selection.Copy
Application.Goto Reference:="R3C27"
ActiveSheet.Paste
Application.Goto Reference:="R1C1"
'''delete all A to Z first
Application.Goto Reference:="R1C1"
ActiveCell.Columns("A:Z").EntireColumn.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Application.Goto Reference:="R1C1"
'''run macro to get files in folder
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Run "Now_GetFileProperties"
'''go to the sheet ListFiles
Application.Goto Reference:="R1C1"
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
End Sub
Sub Macro20()
'find last row in C, put in A2 for use later
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
'minus 7 in A2, as the data starts on row7
Application.Goto Reference:="R2C1"
Selection.FormulaR1C1 = "=R[-1]C-7"
End Sub
Sub Macro21()
'''add path to column B, use A1 as the range to paste
Sheets("ListFiles").Select
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R7C2"
Selection.FormulaR1C1 = "=R3C1&RC[1]"
Selection.Copy
Selection.Copy
''' ActiveCell.Range("A1:A641989").Select
ActiveCell.Range("A1:A" & Range("a2")).Select
ActiveSheet.Paste
Calculate
Selection.Copy
''paste as values
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Sub Macro22()
'copy to A, so it is a backup
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:A641989").Select
ActiveCell.Range("A1:A" & Range("a2")).Select
Application.CutCopyMode = False
Selection.Copy
Application.Goto Reference:="R7C1"
ActiveSheet.Paste
End Sub
Sub Macro23()
'best fit columns
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()
'open file based on cell B1
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:="C:\temp2\6489\TankMan.csv"
''open as cell B1
Workbooks.Open Filename:=Range("b1")
''save as Temp, so it is a static name, and easier to work with a static name. should not matter, as you're copying the data and not manipulating the data in here
ActiveWorkbook.SaveAs Filename:="C:\temp2\6489\temp_delete_me.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Sub Macro30()
'put number of row and columns in A1 and B1. Messing up your header in row 1, but should not matter, since your data all have the same header.
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()
'''copy data from
Application.DisplayAlerts = False
Windows("temp_delete_me.xlsx").Activate
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R2C1"
'' ActiveCell.Rows("1:64").EntireRow.Select
'''based A1 minus1, for the number of rows. minus1, since you are not copying row1
ActiveCell.Rows("1:" & Range("a1") - 1).EntireRow.Select
Application.CutCopyMode = False
Selection.Copy
'''really important here. assumes column A is ALWAYS filled with data. If a cell in column A does not have data, this will overwrite the data in B to XFC
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"
'close temp sheet
Windows("temp_delete_me.xlsx").Activate
ActiveWindow.Close
End Sub