Append Excel Sheet from constantly updating delimited text file

Here is the scenario.

I have a production machine that appends data to a delimited text file every
10 seconds. Every night, someone has to change the file name. The name they
change it to is never consistent. However, whatever they change it to in the
program, will begin appending data. The previous file will not be modified
again.

I need to write a script that will scan, every minute or so, for the current
file being modified and append the data to an existing Excel spreadsheet.

I have written a script that will scan one particular file name every 10
seconds and append the data that is being written to it to a named excel
sheet. The script is below. What I need is for the code to not look for the
specified file, in this case 1.txt, but any file in the directory being
currently modified.


strFile = "c:\control\1.txt"
intSeconds = 5
strDataDelimiter = " "
strExcelFile = "C:\control\data3.xls"
Const intForReading = 1
Const xlUp = -4162
Const xlInsertDeleteCells = 1
Const xlDelimited = 1
Const xlTextQualifierDoubleQuote = 1
Set objFSO = CreateObject ("Scripting.FileSystemObject")

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceModificationEvent WITHIN " & intSeconds & " WHERE
" _
& "TargetInstance ISA 'CIM_DataFile' AND " _
& "TargetInstance.Name='" & Replace(strFile, "\", "\\") & "'")

Do
Set objLatestEvent = colMonitoredEvents.NextEvent


Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
objExcelApp.Workbooks.Open strExcelFile

objExcelApp.ActiveSheet.Range("A1").Select
On Error Resume Next
objExcelApp.Selection.QueryTable.Refresh False
' Check if no error was raised
If Err.Number = 0 Then
' MsgBox "Existing data refreshed."
' Otherwise if there was an error refreshing the querytable, do the
whole process again
Else
Err.Clear
On Error GoTo 0
objExcelApp.ActiveSheet.Cells.Delete

With
objExcelApp.ActiveSheet.QueryTables.Add("TEXT;c:\c ontrol\1.txt",
objExcelApp.ActiveSheet.Range("A1"))
.Name = "data3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = ""
.TextFileOtherDelimiter = ":"
.TextFileOtherDelimiter = "\"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh False
End With
End If

objExcelApp.ActiveWorkbook.Save
objExcelApp.Quit
Set objExcelApp = Nothing

'MsgBox "Done"
Loop

If the only file in the directory is a txt file then you might replace the
strFile = "C:\control\1.txt"
with
strFile = "C:\control\*.txt"

Cheers,
Shane Devenshire


"Ker G" wrote in message
...
Here is the scenario.

I have a production machine that appends data to a delimited text file
every
10 seconds. Every night, someone has to change the file name. The name
they
change it to is never consistent. However, whatever they change it to in
the
program, will begin appending data. The previous file will not be
modified
again.

I need to write a script that will scan, every minute or so, for the
current
file being modified and append the data to an existing Excel spreadsheet.

I have written a script that will scan one particular file name every 10
seconds and append the data that is being written to it to a named excel
sheet. The script is below. What I need is for the code to not look for
the
specified file, in this case 1.txt, but any file in the directory being
currently modified.


strFile = "c:\control\1.txt"
intSeconds = 5
strDataDelimiter = " "
strExcelFile = "C:\control\data3.xls"
Const intForReading = 1
Const xlUp = -4162
Const xlInsertDeleteCells = 1
Const xlDelimited = 1
Const xlTextQualifierDoubleQuote = 1
Set objFSO = CreateObject ("Scripting.FileSystemObject")

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceModificationEvent WITHIN " & intSeconds & "
WHERE
" _
& "TargetInstance ISA 'CIM_DataFile' AND " _
& "TargetInstance.Name='" & Replace(strFile, "\", "\\") & "'")

Do
Set objLatestEvent = colMonitoredEvents.NextEvent


Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
objExcelApp.Workbooks.Open strExcelFile

objExcelApp.ActiveSheet.Range("A1").Select
On Error Resume Next
objExcelApp.Selection.QueryTable.Refresh False
' Check if no error was raised
If Err.Number = 0 Then
' MsgBox "Existing data refreshed."
' Otherwise if there was an error refreshing the querytable, do the
whole process again
Else
Err.Clear
On Error GoTo 0
objExcelApp.ActiveSheet.Cells.Delete

With
objExcelApp.ActiveSheet.QueryTables.Add("TEXT;c:\c ontrol\1.txt",
objExcelApp.ActiveSheet.Range("A1"))
.Name = "data3"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = ""
.TextFileOtherDelimiter = ":"
.TextFileOtherDelimiter = "\"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh False
End With
End If

objExcelApp.ActiveWorkbook.Save
objExcelApp.Quit
Set objExcelApp = Nothing

'MsgBox "Done"
Loop