VBA script to verify that file size is increasing

Hi everyone!

I'm trying to write a VBA script to use in Excel, and being a total VBA noob myself, I would very much appreciate any help I can get with this.

I basically need a script that will monitor a specific folder on my network, and check that the folder (or a specific file in the folder) is continously increasing in size. If the file/folder is increasing in size, the script should change the content of a cell in my xls document from "IDLE" to "OK" or something like that. Of course, if the file should stop increasing the value of the cell should go back to "IDLE".

I would very much like some input on how to accomplish this!

Thanks,

Fred

1) Are you using a Mac
2) Is increasing relative to the file size 1 day ago, 1 minute ago,...
How long can the file remain un-changed before it becomes "IDLE"?

Quote:

---

Originally Posted by mikerickson

1) Are you using a Mac
2) Is increasing relative to the file size 1 day ago, 1 minute ago,...
How long can the file remain un-changed before it becomes "IDLE"?

---

hi mike,

thanks for the reply, I'll try to be more precise:

1) no, I'm on a PC

2) the file that this script will be monitoring is a video file being encoded by windows media encoder, and as such it will increase in size as long as it is being encoded, which will be about 2-3 hours. I need the script to continously verify that this is actually happening, so an ideal scenario would be for the script to check the file every ten seconds and compare the file size between those intervals. If the file size has increased (or even changed, I suppose) =OK, if it hasn't =IDLE.

I hope this provided you with the information you were looking for!

/Fred

[VBA]Option Explicit
Sub CheckFileSize()
Dim objFS, objFile
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile("c:\temp\test.txt")

'Assume that the file is IDLE initially, cell A1 has value of IDLE.
'The size of the file is stored in cell A2 e.g. 1024 (in bytes)
'Check if the size is same as size in cell A2
If objFile.Size = Sheets(1).Cells(1, 2) Then
Sheets(1).Cells(1, 1).Value = "IDLE"
Else
Sheets(1).Cells(1, 1).Value = "DIFFERENT"
'Update cell A2 with new value
Sheets(1).Cells(1, 2).Value = objFile.Size
End If
End Sub[/VBA]

Quote:

---

Originally Posted by nirvana_1

Option Explicit
Sub CheckFileSize()
Dim objFS, objFile
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile("c:\temp\test.txt")

'Assume that the file is IDLE initially, cell A1 has value of IDLE.
'The size of the file is stored in cell A2 e.g. 1024 (in bytes)
'Check if the size is same as size in cell A2
If objFile.Size = Sheets(1).Cells(1, 2) Then
Sheets(1).Cells(1, 1).Value = "IDLE"
Else
Sheets(1).Cells(1, 1).Value = "DIFFERENT"
'Update cell A2 with new value
Sheets(1).Cells(1, 2).Value = objFile.Size
End If
End Sub

---

Thanks nirvana! This is very close to what I'm looking for, now I just need to get this running every ten seconds.

Is there a way to start the script manually and get it to run automatically with ten second intervals? And also, it might be a better idea to monitor the folders size instead of the filesize. Is that doable?

Thanks alot for the help!
/Fred

Copy the program given below into notepad and save the file as .vbs file e.g. c:\test.vbs

Open a new command prompt and type

cscript c:\test.vbs

to start the program. Hope this is what you want. In case you want to terminate the program, you can use Ctrl+C.

------------------------------------------

[VBA]Option Explicit
Dim objFS, objFolder, i, myFolderSize
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder("c:\temp")
i = 1
myFolderSize=0
WScript.Echo "---------------------------"
Do While i = 1
If objFolder.Size = myFolderSize Then
WScript.Echo "IDLE"
WScript.Echo "Folder Name: " & objFolder.Path
WScript.Echo "Folder Size: " & objFolder.Size
WScript.Echo "---------------------------"
Else
WScript.Echo "DIFFERENT"
WScript.Echo "Folder Name: " & objFolder.Path
WScript.Echo "Old Folder Size: " & myFolderSize
WScript.Echo "New Folder Size: " & objFolder.Size
WScript.Echo "---------------------------"
'Update myFolderSize with new value
myFolderSize = objFolder.Size
End If
WScript.Sleep 10000
Loop
objFS.Close[/VBA]

You need to use OnTime(). Otherwise, you will have alot of cpu time being expended.

Quote:

---

Originally Posted by nirvana_1

Copy the program given below into notepad and save the file as .vbs file e.g. c:\test.vbs

Open a new command prompt and type

cscript c:\test.vbs

to start the program. Hope this is what you want. In case you want to terminate the program, you can use Ctrl+C.

------------------------------------------

[vba]Option Explicit
Dim objFS, objFolder, i, myFolderSize
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder("c:\temp")
i = 1
myFolderSize=0
WScript.Echo "---------------------------"
Do While i = 1
If objFolder.Size = myFolderSize Then
WScript.Echo "IDLE"
WScript.Echo "Folder Name: " & objFolder.Path
WScript.Echo "Folder Size: " & objFolder.Size
WScript.Echo "---------------------------"
Else
WScript.Echo "DIFFERENT"
WScript.Echo "Folder Name: " & objFolder.Path
WScript.Echo "Old Folder Size: " & myFolderSize
WScript.Echo "New Folder Size: " & objFolder.Size
WScript.Echo "---------------------------"
'Update myFolderSize with new value
myFolderSize = objFolder.Size
End If
WScript.Sleep 10000
Loop
objFS.Close[/vba]

---

Excellent. This looks really promising!
It runs like a charm from the command prompt, I just need it to work in my xls sheet and I'm not sure how to accomplish that. I need the values "IDLE" or "DIFFERENT" to go into a cell in the sheet, and also some way to shut this script down from inside excel.

Thanks alot!

There is no need to quote all of a post. If you must quote, please just quote parts.

See Chip's OnTime() page for examples using OnTime() and API methods.

Here is my OnTime() method. I used early binding for the FileScripting method. You will need to add it by Tools > References. See the comments in my code for details. You can of course use late binding for the FileSystemObject as nirvana_1 did if you like. I could have coded FolderSize() to a one liner but functions like it make for easy use in other projects.

Add your own worksheet name and cell address for the results cell. Change the constant to fit your drive:\path to monitor.

Put all of this in a Module. Run WatchFolder1Now to start watching. It will always be IDLE for the first interval.
[VBA]Public dTime As Date
Public fsOld As Long
Const fldrName = "X:\Misc"


Sub WatchFolder1Now()
fsOld = FolderSize(fldrName)
StartTimer
ThisWorkbook.Worksheets("Sheet1").Range("A1").Value = "IDLE"
End Sub


Sub WatchFolder1()
Dim resultsCell As Range
Set resultsCell = ThisWorkbook.Worksheets("Sheet1").Range("A1")

If fsOld = FolderSize(fldrName) Then
resultsCell.Value = "IDLE"
StopTimer
Else
resultsCell.Value = "DIFFERENT"
fsOld = FolderSize(fldrName)
StartTimer
End If
End Sub


Function FolderSize(sfolder As String) As Long
Rem Needs Reference: MicroSoft Script Runtime, scrrun.dll
Rem Instructions: http://support.microsoft.com/default...b;en-us;186118
Dim FSO As FileSystemObject
Dim fldr As folder

Set FSO = New FileSystemObject
Set fldr = FSO.GetFolder("x:\Misc")

FolderSize = fldr.Size
Set fldr = Nothing
Set FSO = Nothing
End Function


Sub StartTimer()
dTime = Now + TimeValue("00:00:15")
Application.OnTime dTime, "WatchFolder1", , True
End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime dTime, "WatchFolder1", , False
End Sub
[/VBA]

Thank you, Kenneth!

That was exactly what I was looking for. Many thanks!