S
sven.wuenschmann
Hello Excel programmers,
I am developing an Excel application that uses data from a csv file
that resides on a network directory. The application is importing the
data into a sheet via the common QueryTable object. The data is
updated a couple of times during the day and stored in a new file to
leave an update history. Excel polls in regular time intervalls for
new data to keep up to date automatically.
Issue:
--------
As long as there is just one instance of Excel polling for new data
and importing the new file the application works fine. The issue
arises when multiple instances try to import the new file
concurrently. It seems that one instance looks the file for exclusive
usage. Concurrent attempts to do a QueryTable.Refresh are raising a
"VBA Error 400".
Request for relief:
-------------------------
Does anyone know how to access a file via QueryTable in a non-
exclusive mode? The file needs not to be locked as it is used read-
only. How can a concurrent QueryTable.Refresh by many Excel instances
be implemented?
Attached you will find the full source for the update function. It
gets called periodically by an housekeeping and scheduling function.
Best regards and thanks in advance,
Sven
Source:
----------
'
*****************************************************************************
' * Import new imagine data if available
' *
' * Polls for new imagine report and loads it if newer than currently
used one.
' *
' * Return:
' * - True if new data was imported, False otherwise
'
*****************************************************************************
Public Function RefreshQueryTable() As Boolean
Dim strDirName As String
Dim strCurFileName As String
Dim strLatestFileName As String
Dim curTimeStamp As Variant
Dim latestTimeStamp As Variant
Dim strSemaphoreFile As String
RefreshQueryTable = False
' Get directory name of currently loaded Imagine report
strDirName =
GetDirName(ThisWorkbook.Sheets("Positions").QueryTables(1).Connection)
' return if semaphore file is present as FTP-transmission is in
place
strSemaphoreFile = Dir(strDirName & SEMAPHORE_FILE)
If (strSemaphoreFile <> "") Then
LogDebugMessage "Found the semaphore file """ & SEMAPHORE_FILE
& """. Aborting RefreshQueryTable()"
GoTo ReturnRefreshQueryTable
End If
strCurFileName =
GetFileName(ThisWorkbook.Sheets("Positions").QueryTables(1).Connection)
strLatestFileName = GetLatestFileName(strDirName,
REPORT_NAME_PATTERN)
' nothing to do if no imagine report is available
On Error GoTo ReturnRefreshQueryTable:
latestTimeStamp = FileDateTime(strDirName & strLatestFileName)
' always refresh if currently loaded imagine report is no longer
available (e.g. first run in the morning)
On Error GoTo DoRefreshQueryTable:
curTimeStamp = FileDateTime(strDirName & strCurFileName)
' refresh if
' newest imagine report available is newer than the currently
loaded one
' or
' forced to reload latest if imagine data cell in status info is
empty (we assured that it is available)
If ((latestTimeStamp > curTimeStamp) Or
(ThisWorkbook.GetImgReportTime() = "")) Then
DoRefreshQueryTable:
ThisWorkbook.SetImgReportTime ("L O A D I N G")
LogDebugMessage "Loading new position data (Imagine report): "
& _
"""TEXT;" & strDirName & strLatestFileName & """"
On Error GoTo CatchRefreshError:
With ThisWorkbook.Sheets("Positions").QueryTables(1)
.Connection = "TEXT;" & strDirName & strLatestFileName
.Destination =
ThisWorkbook.Sheets("Positions").Range(QUERY_TABLE_DESTINATION)
.TextFilePlatform = 20127 ' US-ASCII
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 5, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
ThisWorkbook.SetImgReportTime (latestTimeStamp)
RefreshQueryTable = True
LogInfoMessage "Position data (Imagine report """ &
strLatestFileName & """) successfully reloaded"
' force to evaluate our new positions
If (Not Application.Calculation = xlCalculationAutomatic) Then
ThisWorkbook.Sheets("Positions").Calculate
End If
End If
Exit Function
CatchRefreshError:
ThisWorkbook.SetImgReportTime ("")
LogErrorMessage "Excel could not refresh position data: " &
Err.Description & _
" (" & Err.Number & ")"
'MsgBox "Excel could not refresh position data: " &
Err.Description & _
' " (" & Err.Number & ")"
ReturnRefreshQueryTable:
End Function
I am developing an Excel application that uses data from a csv file
that resides on a network directory. The application is importing the
data into a sheet via the common QueryTable object. The data is
updated a couple of times during the day and stored in a new file to
leave an update history. Excel polls in regular time intervalls for
new data to keep up to date automatically.
Issue:
--------
As long as there is just one instance of Excel polling for new data
and importing the new file the application works fine. The issue
arises when multiple instances try to import the new file
concurrently. It seems that one instance looks the file for exclusive
usage. Concurrent attempts to do a QueryTable.Refresh are raising a
"VBA Error 400".
Request for relief:
-------------------------
Does anyone know how to access a file via QueryTable in a non-
exclusive mode? The file needs not to be locked as it is used read-
only. How can a concurrent QueryTable.Refresh by many Excel instances
be implemented?
Attached you will find the full source for the update function. It
gets called periodically by an housekeeping and scheduling function.
Best regards and thanks in advance,
Sven
Source:
----------
'
*****************************************************************************
' * Import new imagine data if available
' *
' * Polls for new imagine report and loads it if newer than currently
used one.
' *
' * Return:
' * - True if new data was imported, False otherwise
'
*****************************************************************************
Public Function RefreshQueryTable() As Boolean
Dim strDirName As String
Dim strCurFileName As String
Dim strLatestFileName As String
Dim curTimeStamp As Variant
Dim latestTimeStamp As Variant
Dim strSemaphoreFile As String
RefreshQueryTable = False
' Get directory name of currently loaded Imagine report
strDirName =
GetDirName(ThisWorkbook.Sheets("Positions").QueryTables(1).Connection)
' return if semaphore file is present as FTP-transmission is in
place
strSemaphoreFile = Dir(strDirName & SEMAPHORE_FILE)
If (strSemaphoreFile <> "") Then
LogDebugMessage "Found the semaphore file """ & SEMAPHORE_FILE
& """. Aborting RefreshQueryTable()"
GoTo ReturnRefreshQueryTable
End If
strCurFileName =
GetFileName(ThisWorkbook.Sheets("Positions").QueryTables(1).Connection)
strLatestFileName = GetLatestFileName(strDirName,
REPORT_NAME_PATTERN)
' nothing to do if no imagine report is available
On Error GoTo ReturnRefreshQueryTable:
latestTimeStamp = FileDateTime(strDirName & strLatestFileName)
' always refresh if currently loaded imagine report is no longer
available (e.g. first run in the morning)
On Error GoTo DoRefreshQueryTable:
curTimeStamp = FileDateTime(strDirName & strCurFileName)
' refresh if
' newest imagine report available is newer than the currently
loaded one
' or
' forced to reload latest if imagine data cell in status info is
empty (we assured that it is available)
If ((latestTimeStamp > curTimeStamp) Or
(ThisWorkbook.GetImgReportTime() = "")) Then
DoRefreshQueryTable:
ThisWorkbook.SetImgReportTime ("L O A D I N G")
LogDebugMessage "Loading new position data (Imagine report): "
& _
"""TEXT;" & strDirName & strLatestFileName & """"
On Error GoTo CatchRefreshError:
With ThisWorkbook.Sheets("Positions").QueryTables(1)
.Connection = "TEXT;" & strDirName & strLatestFileName
.Destination =
ThisWorkbook.Sheets("Positions").Range(QUERY_TABLE_DESTINATION)
.TextFilePlatform = 20127 ' US-ASCII
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 5, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
ThisWorkbook.SetImgReportTime (latestTimeStamp)
RefreshQueryTable = True
LogInfoMessage "Position data (Imagine report """ &
strLatestFileName & """) successfully reloaded"
' force to evaluate our new positions
If (Not Application.Calculation = xlCalculationAutomatic) Then
ThisWorkbook.Sheets("Positions").Calculate
End If
End If
Exit Function
CatchRefreshError:
ThisWorkbook.SetImgReportTime ("")
LogErrorMessage "Excel could not refresh position data: " &
Err.Description & _
" (" & Err.Number & ")"
'MsgBox "Excel could not refresh position data: " &
Err.Description & _
' " (" & Err.Number & ")"
ReturnRefreshQueryTable:
End Function