AS I said, this would be best suited to run in a separate instance of Excel. There's no way to know what impact loading workbooks will have if someone is already working on something when this kicks off...
So, in a new workbook, add the following to the ThisWorkbook module
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'// Cancel any scheduled scans - otherwise this workbook will be reopened
'// automatically at that time
If NextRunTime <> 0 Then
Application.OnTime NextRunTime, "ScanFolder", Schedule:=False
End If
End Sub
Private Sub Workbook_Open()
'// Run in 5 seconds... or whatever you want. This is just the
'// initial scan. The next scan after will be time + whatever is defined for
'// RunNext (minutes)
Application.OnTime Now + TimeValue("00:00:05"), "ScanFolder"
End Sub
Add a new code module and add the following
Option Explicit
'// Source and Destination directories. These MUST exist and the trailing '\' is required.
Public Const SourceDir As String = "C:\TEMP\IN\"
Public Const DestDir As String = "C:\TEMP\OUT\"
'// Number of minutes between scans
Public Const RunNext As Double = 60
'// Holds the next scheduled time - needed to Cancel any scheduled runs if/when the
'// workbook is closed.
Public NextRunTime As Date
Public Sub ScanFolder()
Dim strFile As String
Dim wb As Excel.Workbook
With Application
.ScreenUpdating = False
.StatusBar = "Scanning " & SourceDir
End With
'// No information as to the type of files - assuming XLSX only.
strFile = Dir(SourceDir & "*.xlsx")
Do While strFile <> vbNullString
Set wb = Workbooks.Open(SourceDir & strFile, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
With wb
'// Again, no information as to which workssheet so assuming sheet1
With .Sheets(1)
.Range("D2:D" & .Range("C" & Rows.Count).End(3).Row).Formula = "=IF(C2<10,""Standard"",""Expedited"")"
End With
.SaveCopyAs Filename:=DestDir & strFile
.Close SaveChanges:=xlDoNotSaveChanges
End With
Set wb = Nothing
'// If the file was sucessfully saved in the Destination directory
If Dir(DestDir & strFile) <> vbNullString Then
'// Remove from the source directory
Kill SourceDir & strFile
End If
strFile = Dir(SourceDir & "*.xlsx")
Loop
'// Calculate time of next run
NextRunTime = DateAdd("n", RunNext, Now)
'// .. and schedule it.
With Application
.OnTime NextRunTime, "ScanFolder"
.ScreenUpdating = True
.StatusBar = False
End With
End Sub
Make changes as needed to SourceDir, DestDir and RunNext. Also you might want to change the delay before the first scan in the Workbook_Open event.
I look forward to a solution.
I much prefer to see someone make an attempt at a solution. Fixing code that doesn't work (even if it is all thrown away and simply replaced) makes the place seem more like a 'Help' forum... so to save my time this is not what I would call 'production quality' - for one, the lack of error handling means any problem will stop the code, not ideal but there's no complaining about the value for money aspect of this.
Bookmarks