Hello, I'm an intermediate VBA User with very basic knowledge. I appreciate any help in what I hope is one or two lines of code.
I'm using this Code from Jerry Beaucaire, below, with some modifications... I'm not moving files to another folder;
My Goal is to pull specific cell data from certain sheets within each workbook and all is working well in the coding so far
My Request is to pull the File Save Date (DateLastModified) for each file (see Blue Text below) in the folder.
Private Sub CommandButton1_Click()
'Author: Jerry Beaucaire'
'Date: 9/15/2009 (2007 compatible) (updated 4/29/2011)
'Summary: Merge files in a specific folder into one master sheet (stacked)
' Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
'Setup
Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now
Application.AskToUpdateLinks = False 'turn off Update Links question
Set wsMaster = ThisWorkbook.Sheets("Pipe") 'sheet report is built into
With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.UsedRange.Offset(1).EntireRow.Clear
NR = 2
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
End If
'Path and filename (edit this section to suit)
'========
MsgBox "Please select a folder with files to consolidate"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\2010\Test\"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
fPath = .SelectedItems(1) & "\"
Exit Do
Else
If MsgBox("No folder chose, do you wish to abort?", _
vbYesNo) = vbYes Then Exit Sub
End If
End With
Loop
'fPathDone = fPath & "Imported\" 'remember final \ in this string
On Error Resume Next
'MkDir fPathDone 'creates the completed folder if missing
On Error GoTo 0
fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired
'========
'OR when you get to work
'fPath = "H:\_Completed Reviews\" 'remember final \ in this string
' On Error Resume Next
' On Error GoTo 0
' fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired
'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) 'Open file
'This is the section to customize, replace with your own action code as needed
LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Workbooks(fName).Worksheets("Updates").Range("A1").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("A" & NR)
Workbooks(fName).Worksheets("Updates").Range("C13").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("B" & NR)
Workbooks(fName).Worksheets("Decn").Range("C8").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("C" & NR)
Workbooks(fName).Worksheets("Updates").Range("G6:J6").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("D" & NR)
NEED HELP ==> ALSO PULL THE FILE (fname) DATE MODIFIED property and PRINT to Column E of (Pipeline.xlsm).Worksheets("Pipe") <NEED HELP Here
'Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
wbData.Close False 'close file
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
' Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
End If
fName = Dir 'ready next filename
Loop
End With
ErrorExit: 'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen
End Sub
I'm using this Code from Jerry Beaucaire, below, with some modifications... I'm not moving files to another folder;
My Goal is to pull specific cell data from certain sheets within each workbook and all is working well in the coding so far
My Request is to pull the File Save Date (DateLastModified) for each file (see Blue Text below) in the folder.
Private Sub CommandButton1_Click()
'Author: Jerry Beaucaire'
'Date: 9/15/2009 (2007 compatible) (updated 4/29/2011)
'Summary: Merge files in a specific folder into one master sheet (stacked)
' Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
'Setup
Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now
Application.AskToUpdateLinks = False 'turn off Update Links question
Set wsMaster = ThisWorkbook.Sheets("Pipe") 'sheet report is built into
With wsMaster
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.UsedRange.Offset(1).EntireRow.Clear
NR = 2
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'appends data to existing data
End If
'Path and filename (edit this section to suit)
'========
MsgBox "Please select a folder with files to consolidate"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\2010\Test\"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
fPath = .SelectedItems(1) & "\"
Exit Do
Else
If MsgBox("No folder chose, do you wish to abort?", _
vbYesNo) = vbYes Then Exit Sub
End If
End With
Loop
'fPathDone = fPath & "Imported\" 'remember final \ in this string
On Error Resume Next
'MkDir fPathDone 'creates the completed folder if missing
On Error GoTo 0
fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired
'========
'OR when you get to work
'fPath = "H:\_Completed Reviews\" 'remember final \ in this string
' On Error Resume Next
' On Error GoTo 0
' fName = Dir(fPath & "*.xls*") 'listing of desired files, edit filter as desired
'Import a sheet from found files
Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then 'don't reopen this file accidentally
Set wbData = Workbooks.Open(fPath & fName) 'Open file
'This is the section to customize, replace with your own action code as needed
LR = Range("A" & Rows.Count).End(xlUp).Row 'Find last row
Workbooks(fName).Worksheets("Updates").Range("A1").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("A" & NR)
Workbooks(fName).Worksheets("Updates").Range("C13").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("B" & NR)
Workbooks(fName).Worksheets("Decn").Range("C8").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("C" & NR)
Workbooks(fName).Worksheets("Updates").Range("G6:J6").Copy _
Workbooks("Pipeline.xlsm").Worksheets("Pipe").Range("D" & NR)
NEED HELP ==> ALSO PULL THE FILE (fname) DATE MODIFIED property and PRINT to Column E of (Pipeline.xlsm).Worksheets("Pipe") <NEED HELP Here
'Range("A1:A" & LR).EntireRow.Copy .Range("A" & NR)
wbData.Close False 'close file
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Next row
' Name fPath & fName As fPathDone & fName 'move file to IMPORTED folder
End If
fName = Dir 'ready next filename
Loop
End With
ErrorExit: 'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen
End Sub