Automatically importing most recent file in folder with VBA every x seconds

[DrZegt]

This is my first time using VBA, so I am not familiar with how it really works. I need a code that continously imports the most recent measurement scan from a certain folder and updates the cells in a certain location with the contents of the txt-file. So far I am using the code below in order to automatically import the file "Scan00.txt" every 10 seconds. Unfortunately the software storing the scans uses padding digits and so the next scan is called "Scan01.txt". I want to modify my code to instead of importing the contents of Scan00, it imports the most recent txt-file in the folder instead.

In the Microsoft Excel Objects folder I have this code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime dTime, "Scanimport", , False
End Sub
 
Private Sub Workbook_Open()
    Application.OnTime Now + TimeValue("00:00:10"), "Scanimport"
End Sub

I then have this module:

Sub Scanimport()


Set shFirstQtr = Workbooks(1).Worksheets(1)
Set qtQtrResults = shFirstQtr.QueryTables _
 .Add(Connection:="TEXT;M:\pc\Desktop\Innovasjonsprosjekt\Test\Scan00", _
 Destination:=Range( _
    "K2"))
With qtQtrResults
    Columns("K:L").Select
    Selection.ClearContents
    .Name = "test"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 737
    .TextFileStartRow = 18
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery = False
    Columns("K:L").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End With
dTime = Now + TimeValue("00:00:10")
    Application.OnTime dTime, "Scanimport"


End Sub

I have found a lot of similar examples on these forums, but they don't use this convenient .Add(Connection:= part, and I don't understand how I can incorporate this in the various codes used to determine the most recent file.

 

[PatOBrien198]

try something like this....

dim myFolder as string
myFolder = "M:\pc\Desktop\Innovasjonsprosjekt\Test\"

Set qtQtrResults = shFirstQtr.QueryTables _
 .Add(Connection:="TEXT;" & myfolder & GetLatestFile(myFolder, "Scan"), _
 Destination:=Range( _
    "K2"))

with the following function..

Function GetLatestFile(folderName As String, MatchThis As String) As String
Dim fname As String
Dim latestFile As String

fname = Dir(folderName & "*" & MatchThis & "*")
latestFile = fname
Do While fname <> ""
    If FileDateTime(folderName & fname) > FileDateTime(folderName & fname) Then
        latestFile = fname
    End If
    fname = Dir
Loop
GetLatestFile = latestFile
'MsgBox latestFile & vbCrLf & FileDateTime(folderName & latestFile)
End Function

 

[DrZegt]

Thanks a lot for your reply! This does nearly what I want it to. I'm not sure if I understand what the code does, but now it imports the same file over and over, despite new scans being saved into the folder. However, if I delete the scan it keeps importing, it goes to the next one. If I somehow now can make sure there is always only the most recent scan in the folder(not sure if I can delete files with VBA yet), then this would be working already, but if anyone can tell me if there is something I can modify so that it actually takes the last saved scan it would be great. Just in case I misunderstood how to apply the function, here is how the module looks now (with the same stuff in the Microsoft Excel Objects).

Function GetLatestFile(folderName As String, MatchThis As String) As String
Dim fname As String
Dim latestFile As String


fname = Dir(folderName & "*" & MatchThis & "*")
latestFile = fname
Do While fname <> ""
    If FileDateTime(folderName & fname) > FileDateTime(folderName & fname) Then
        latestFile = fname
    End If
    fname = Dir
Loop
GetLatestFile = latestFile
'MsgBox latestFile & vbCrLf & FileDateTime(folderName & latestFile)
End Function


Sub Scanimport()


Dim myFolder As String
myFolder = "M:\pc\Desktop\Innovasjonsprosjekt\Test\"


Set shFirstQtr = Workbooks(1).Worksheets(1)
Set qtQtrResults = shFirstQtr.QueryTables _
 .Add(Connection:="TEXT;" & myFolder & GetLatestFile(myFolder, "Scan"), _
 Destination:=Range( _
    "K2"))
With qtQtrResults
    Columns("K:L").Select
    Selection.ClearContents
    .Name = "test"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 737
    .TextFileStartRow = 18
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery = False
    Columns("K:L").Select
    Selection.Replace What:=",", Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End With
dTime = Now + TimeValue("00:00:10")
    Application.OnTime dTime, "Scanimport"


End Sub

 

[PatOBrien198]

The vba command to delete a file is "Kill".

So sorry, the code should be:

    If FileDateTime(folderName & fname) > FileDateTime(folderName &[B][COLOR=#FF0000] l[B]atestFile[/B][/COLOR])[/B] Then
        latestFile = fname
    End If

 

[DrZegt]

Thank you so much! Now it works

 

[PatOBrien198]

Thinking about this further, and I'm not 100% sure that this issue will manifest itself, but....

by doing the querytable.add method, you may end up with a whole bunch of queries in that workbook.

I'll suggest that you try to determine how many queries you've got (Data / Connections) and if it is a problem, then delete most of 'em.

Then record a macro of you editing one, rather than adding one and adjust it to work with the GetLatestFile function.

 

[PatOBrien198]

Another way to accomplish this would be to use your macro to copy the latest file to a standard named file.... e.g. ScanFileToImport.txt

Then your query would be to import the standard named file and it would merely need to be refreshed to import the new file.

This way you would not have to ".add" a new query every time.

The vba to copy a file is merely

FileCopy SourceFilePathName, DestinationFilePathName

so, something like:

  FileCopy  myFolder & GetLatestFile(myFolder, "Scan"), myFolder & "ScanFileToImport.txt"
  ActiveWorkbook.RefreshAll  ' refreshes all queries (should only be one)

So, forget about recording a macro editing a data connection, just have the one standard file import query.

Make sense?

 

[DrZegt]

I'm not sure if understood exactly what part of my code I'm supposed to replace. I get an error with wrong number of arguments or invalid property assignment if I try to add a destination cell for the import, though strangely enough it still imports the data to K2, despite me not specifying this anymore. The script does not seem to run every 10 seconds however, but rather many times per second, which causes either the script or the program to crash at some point. I end up with a few different errors every time I run it, and sometimes it just stops without any error also. In the beginning it started importing at K2 and then used adjacent columns each time. I'm not sure why, but after it crashed and I deleted the extra columns, it now just imports to K2. I'm also not sure exactly what file it grabs. Despite me not saving any new files, it occasinally copies a different file to ScanFileToImport.txt, though it seems to end up with the latest file eventually again. This is the code I try to run now without the ", Destination = Range("K2")". I just included it, to show you where I thought I was supposed to put it.

Sub Scanimport()


Dim myFolder As String
myFolder = "M:\pc\Desktop\Innovasjonsprosjekt\Test\"


FileCopy myFolder & GetLatestFile(myFolder, "Scan"), myFolder & "ScanFileToImport.txt", Destination = Range("K2")
ActiveWorkbook.RefreshAll  ' refreshes all queries (should only be one)


dTime = Now + TimeValue("00:00:10")
    Application.OnTime dTime, "Scanimport"


End Sub

I'm making the code in Excel2016, but will eventually run it in Excel2007. The old code that works fine in 2016, gets an error when I try to run it in the 2007-version. Seems the .Refresh BackgroundQuery = False part of the old script was causing problems, so I hope changing the code like this will solve that problem when I try to run it in Excel2007

 

[PatOBrien198]

Try this.... it worked for me.

Start with a new workbook.

Paste the following code to a module, run the "RunOnce..." routine, then run the "ScanImport" routine.

To stop the repeating of the ScanImport routine, enter any value into A1.

Option Explicit

Sub RunOnceToCreateStandardQuery()
    Dim fileName As String
    Dim myFolder As String
    
    myFolder = "M:\pc\Desktop\Innovasjonsprosjekt\Test\"
    fileName = myFolder & "StandardFileToImport.txt"
            
    FileCopy myFolder & GetLatestFile(myFolder, "Scan"), myFolder & "StandardFileToImport.txt"
    
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileName, _
        Destination:=Range("$K$2"))
        .Name = "StandardScanImport"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 737
        .TextFileStartRow = 18
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
          
    End With
End Sub

Function GetLatestFile(folderName As String, MatchThis As String) As String
    Dim fname As String
    Dim latestFile As String
    fname = Dir(folderName & "*" & MatchThis & "*")
    latestFile = fname
    Do While fname <> ""
        If FileDateTime(folderName & fname) > FileDateTime(folderName & latestFile) Then
            latestFile = fname
        End If
        fname = Dir
    Loop
    GetLatestFile = latestFile
    'MsgBox latestFile & vbCrLf & FileDateTime(folderName & latestFile)
End Function

Sub ScanImport()
    Dim dTime As Date
    Dim myFolder As String
    Dim fileName As String
    
    myFolder = "M:\pc\Desktop\Innovasjonsprosjekt\Test\"
   
    Columns("K:L").ClearContents
    fileName = GetLatestFile(myFolder, "Scan")
    FileCopy myFolder & fileName, myFolder & "StandardFileToImport.txt"
    ActiveWorkbook.RefreshAll  ' refreshes all queries (should only be one)
    dTime = Now + TimeValue("00:00:10")
    If Range("A1") = "" Then   ' so you can stop the repeat if there is anything in A1
        Application.OnTime dTime, "ScanImport"
    End If
    Range("b1") = "File imported: " & fileName
End Sub

 

[DrZegt]

This works like a charm on Excel2016 at least. I won't be able to check whether it works in Excel2007 before tomorrow, but thank you so much for this in any case!