Need help with automatic importing of Data every x minute

gishy

New Member
Joined
Apr 13, 2021
Messages
5
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I currently have an automatic code that can open up the MOST recent (date modified) file in a folder.
It works great BUT my concern is:
Lets say i set a timer of 10 mins to execute this macro, However the macro takes 15 mins to run and inside that space of 15 mins another 2 files are uploaded FileA and FileB.
This code will then execute FileB next as FileB is deemded as the "most recent file" however FileA is lost in the process.
May I know if there is anything I can add to the code to create some sort of queue system? So that in any unforeseen case of longer waiting time then with my scheduled timer, the code still keeps track of FileA and it will proceed to run the macro on FileA then FileB. I have attached my code below for reference.
Any help is greatly appreciated.
Thanks in advance!




VBA Code:
Option Explicit
Dim RunTimer As Date



Sub recentFileSpecificFolder()
Dim myFile As String, myRecentFile As String, myMostRecentFile As String
Dim recentDate As Date
Dim myDirectory As String
myDirectory = "C:\Users\Textfiles\"
Dim fileExtension As String
fileExtension = "*.txt"

RunTimer = Now + TimeValue("00:10:00")

Application.OnTime RunTimer, "recentFileSpecificFolder"

If Right(myDirectory, 1) <> "\" Then myDirectory = myDirectory & "\"

myFile = Dir(myDirectory & fileExtension)

If myFile <> "" Then
    myRecentFile = myFile
    recentDate = FileDateTime(myDirectory & myFile)
Do While myFile <> ""
    If FileDateTime(myDirectory & myFile) > recentDate Then
        myRecentFile = myFile
        recentDate = FileDateTime(myDirectory & myFile)
    End If
    myFile = Dir
Loop
End If
myMostRecentFile = myRecentFile
Workbooks.Open Filename:=myDirectory & myMostRecentFile



End Sub

Sub StoptheCode()

Application.OnTime RunTimer, "recentFileSpecificFolder", , False

MsgBox "The application has been stopped."
End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
What about speeding up your macro that takes 15 minutes to run.
One easy thing to do to make sure you process file in order is to change the file name of the file when you process by adding "old" at the front of the filename and reject all files which start with that name in your existing check. Then change your check to always process the OLDEST file
rename a file code:
VBA Code:
Name mymostrecentFile As oldmymostrecentfile
 
Upvote 0
How about changing the logic somewhat. Instead of limiting the processing time for each file to 10 minutes, how about if you had a routine that ran every minute that checked for more files and if it found some it pushed them onto a queue object. then you have a routine which pulled the files off the queue one at a time for processing.

you would need a way to know what files are already on the queue and which are processed. you would also need to be sure the queue is large enough to handle an absolute maximum number of files. i would consider some classes and custom events to help manage all this.
 
Upvote 0
here is some code to implement a queue class in VBA. There are two class modules.

class 1 is named clsQueueItem:
VBA Code:
Option Explicit
'
' Class  clsQueueItem
'
' Public fields
Public NextItem As New clsQueueItem
Public Value As Variant

class2 is named clsQueue
VBA Code:
Option Explicit
'
' Class clsQueue
'
' Remarks:
' Represents a first-in, first-out collection of objects.
' Queues are useful for storing messages in the order they were received for sequential processing.
' Objects stored in a Queue are inserted at one end and removed from the other.

' Private fields
Private head As clsQueueItem
Private tail As clsQueueItem
Private countQ As Long
'
' Constructor
'
' Initializes a new instance of the Queue class that is empty.
Private Sub Class_Initialize()
  countQ = 0
End Sub
'
' Destructor
'
' Destruct resources and perform other cleanup operations
Private Sub Class_Terminate()
  countQ = 0
  Set head = Nothing
  Set tail = Nothing
End Sub
'
' Properties
'
' Returns a Boolean value indicating whether a Queue has items.
Public Property Get IsEmpty() As Boolean
  IsEmpty = ((head Is Nothing) And (tail Is Nothing))
End Property
' Gets the number of elements contained in the Queue.
Public Property Get Count() As Long
  Count = countQ
End Property
' Returns the object at the beginning of the Queue without removing it.
Public Property Get Peek() As Variant
  Peek = head.Value
End Property
'
' Methods
'
' Adds an object to the end of the Queue.
Public Function Enqueue(v As Variant)
  Dim queueItem As New clsQueueItem
  If IsObject(v) Then
    Set queueItem.Value = v
  Else
    queueItem.Value = v
  End If
  If Me.IsEmpty = True Then
    Set head = queueItem
    Set tail = head
  Else
    Set tail.NextItem = queueItem
    Set tail = queueItem
  End If
  countQ = countQ + 1
  Set queueItem = Nothing
End Function
' Removes and returns the object at the beginning of the Queue.
Public Function Dequeue() As Variant
  If Me.IsEmpty = True Then
    Dequeue = Null
  Else
    If IsObject(head.Value) Then
      Set Dequeue = head.Value
    Else
      Dequeue = head.Value
    End If
    If head Is tail Then
      Clear
'      Set head = Nothing
'      Set tail = Nothing
'      countQ = 0
    Else
      Set head = head.NextItem
      countQ = countQ - 1
    End If
  End If
End Function
' Removes all objects from the Queue.
Public Function Clear()
  countQ = 0
  Set head = Nothing
  Set tail = Nothing
End Function
' Copies the Queue elements to a new array.
Public Function ToArray() As Variant
  Dim sizeQ As Long
  Dim result() As Variant
  Dim index As Long
  Dim tmp As clsQueueItem
  sizeQ = Me.Count - 1
  If sizeQ > -1 Then
    ReDim result(sizeQ)
    Set tmp = head
    For index = 0 To sizeQ
      If IsObject(tmp.Value) Then
        Set result(index) = tmp.Value
      Else
        result(index) = tmp.Value
      End If
      Set tmp = tmp.NextItem
    Next index
    ToArray = result
  Else
    Erase result
  End If
  Set tmp = Nothing
End Function

You should be able to queue all standard datatypes, collections, arrays, and other objects.

My suggestion is that you implement a routine based on a timer to queue file names for later processing. The frequency of the timer will be dependent on how frequently the folder is updated by your users. One could also utilize some kind of event processing to control the routine that takes files off the queue to process. I am interested in this and am going to do some experimenting of my own. I will update you as I get more information.
 
Upvote 0

Forum statistics

Threads
1,224,813
Messages
6,181,117
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top