Hello,
I am running the following code (below) that is working great with one exception - if I am not specifically on the 'Webstats_RptList_RawData' tab in the active Workbook, the code will not bring in the latest records from the OneDrive folder that the target Excel files reside in it. How do I adjust the code to ensure that the 'Webstats_RptList_RawData' tab is the 'active' tab so that the code grabs the latest records from the target OneDrive folder and does not merely refresh the records already present in the 'Webstats_RptList_RawData' tab?
Sub GetDetails_and_SplitDlyHrlyRpts()
Dim oShell As Object
Dim oFile As Object
Dim oFldr As Object
Dim lRow As Long
Dim iCol As Integer
Dim vArray As Variant
vArray = Array(0, 1, 2, 3, 4) ', 10, 20)
'0=Name, 1=Size, 2=Item Type, 3=Date Modified, 4=Date Created, 10=Owner, 20=Authors
Dim firstrowDB As Long, LastRow As Long
Dim arr1, arr2, i As Integer
Dim src As Worksheet
Dim trg As Worksheet
'**************************************************************************************************************************************************
'*** This script gets the following file Property Details from the .CSV attachments that were copied from the selected Outlook emails (and then
' written to 'C:\Users\ptdooley\OneDrive - Commonwealth of Massachusetts\HIX_Materials\HIX_WebStats\Webstats_Rpts\Orig_CSV_Rpts' folder):
' 1) File name
' 2) File size
' 3) File type
' 4) Date Modified
' 5) Date Created
'These file details are written to the 'Webstats_RptList_RawData' Worksheet present in this Workbook. The data from the 'Webstats_RptList_RawData' Worksheet
' is then copied to the 'RptData_Cleaned' Worksheet, where additional descriptive fields are added and the file extensions are changed from .CSV to
' .XLSM so that later scripts can be run in order to add the Webstats counts to the end of the descriptive fields added in this script***
'**************************************************************************************************************************************************
'Clear all data from the 'Webstats_RptList_RawData' tab
'Webstats_RptList_RawData.Cells.ClearContents
'Sheets("Webstats_RptList_RawData").UsedRange.ClearContents
'Clear all data from the 'RptData_Cleaned' tab
'Webstats_RptList_RawData.Cells.ClearContents
'Sheets("RptData_Cleaned").UsedRange.ClearContents
' Get file details ('Date Created', 'Date Modified', etc.) from the
' 'C:\Users\ptdooley\OneDrive - Commonwealth of Massachusetts\HIX_Materials\HIX_WebStats\Webstats_Rpts\Orig_CSV_Rpts\Orig_CSV_Rpts_Archive' folder
'ThisWorkbook.UpdateLinks = xlUpdateLinksNever
Set oShell = CreateObject("Shell.Application")
lRow = 1
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the Folder..."
If .Show Then
Set oFldr = oShell.Namespace(.SelectedItems(1))
With oFldr
For iCol = LBound(vArray) To UBound(vArray)
Cells(lRow, iCol + 1) = .getdetailsof(.items, vArray(iCol))
Next iCol
For Each oFile In .items
lRow = lRow + 1
For iCol = LBound(vArray) To UBound(vArray)
Cells(lRow, iCol + 1) = .getdetailsof(oFile, vArray(iCol))
Next iCol
Next oFile
End With
End If
End With
'ThisWorkbook.UpdateLinks = xlUpdateLinksAlways
'Now copy all of the 'raw' data fom the 'Webstats_RptList_RawData' tab in this workbook to Columns A-E in the 'RptData_Cleaned' tab
Set src = ThisWorkbook.Worksheets("Webstats_RptList_RawData")
Set trg = ThisWorkbook.Worksheets("RptData_Cleaned")
src.Range("A:A").Copy Destination:=trg.Range("A1")
src.Range("B:B").Copy Destination:=trg.Range("B1")
src.Range("C:C").Copy Destination:=trg.Range("C1")
src.Range("D:D").Copy Destination:=trg.Range("D1")
src.Range("E:E").Copy Destination:=trg.Range("E1")
'Change Excel file extension from ".csv" to ".xlsm" so that the Webstats counts (and their associated report dates) can be added to
'the other descriptive fields tacked on in the "RptData_Cleaned" tab
With trg.Range("A:A")
'With trg
Do Until .Find(".csv") Is Nothing
.Replace ".csv", ".xlsm"
Loop
'End With
End With
'Finally, write the 'Daily' report rows to the "DailyRptRecords" tab in this workbook and write the 'Hourly'
'report rows to the "HourlyRptRecords"
Application.DisplayAlerts = False
Dim RowCnt As Long
Dim DlyWksht As Worksheet
Dim HrlyWksht As Worksheet
Dim rng As Range
Set DlyWksht = Sheets("DailyRptRecords")
Set HrlyWksht = Sheets("HourlyRptRecords")
With DlyWksht
.Range("A2:H" & .Cells(.Rows.Count, "A").End(xlUp).Row).ClearContents
End With
With HrlyWksht
.Range("A2:H" & .Cells(.Rows.Count, "A").End(xlUp).Row).ClearContents
End With
RowCnt = Worksheets("RptData_Cleaned").UsedRange.Rows.Count
For Each rng In Worksheets("RptData_Cleaned").Range("A2:A" & RowCnt)
If rng Like "*_Daily_*" Then
rng.EntireRow.Copy DlyWksht.Cells(DlyWksht.Rows.Count, "A").End(xlUp).Offset(1, 0)
ElseIf rng Like "*_Hourly_*" Then
rng.EntireRow.Copy HrlyWksht.Cells(HrlyWksht.Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next rng
Application.DisplayAlerts = True
End Sub
Bookmarks