Question : How to refresh DDE links?

A program I use to connect to feed data to Excel works via a DDE link. There are several DDE links within my spreadsheet that I need to update every second. The command lines of the dde link are arrays that define the parameters of the call to the external program.
What is the best way to refresh the data every second?
Currently, I have a method working that I'm not overly satisfied with. I run an OnTime macro to change one part of the array each second. This causes the link to update correctly but causes a the data on screen to disappear for a split second whilst the link is being changed and Excel has to make all the calculations that relate to this source data. Below is my working code.
When the data disappears, all my calcs go into error until the data reappears. I also have an XML feed into the same spreadsheet every 2 seconds. When both feeds are updated at the same time (every 2 seconds), the data errors for nearly one second!!! As you can see, I have added DoEvents & ScreenUpdating to try & improve this issue.

Code Snippet:

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:



Sub Update1()
    If runThem Then
    Application.ScreenUpdating = False
    Worksheets("Place Data").Range("A49:AJ242").Replace What:=",29", Replacement:=",30", LookAt:=xlPart, SearchOrder:=xlByRows
    DoEvents
    Set oddsFile = CreateObject("Scripting.FileSystemObject")
    oddsFile.CopyFile "C:\Program Files\Aus\Aus4\dds.txt", "C:\Program Files\Aus\Aus4\dds2.txt"    
    Worksheets("Place Data").Range("EB2").QueryTable.refresh BackgroundQuery:=False
    DoEvents
    Application.OnTime Now() + TimeSerial(0, 0, 1), "Update2"
    Application.ScreenUpdating = True
    End If
End Sub
Sub Update2()
    If runThem Then
    Application.ScreenUpdating = False
    Worksheets("Place Data").Range("A49:AJ242").Replace What:=",30", Replacement:=",29", LookAt:=xlPart, SearchOrder:=xlByRows
    DoEvents
    Set oddsFile = CreateObject("Scripting.FileSystemObject")
    oddsFile.CopyFile "C:\Program Files\Aus\Aus4\dds.txt", "C:\Program Files\Aus\Aus4\dds2.txt"
    Worksheets("Place Data").Range("EB2").QueryTable.refresh BackgroundQuery:=False
    DoEvents
    Application.OnTime Now() + TimeSerial(0, 0, 1), "Update1"
    Application.ScreenUpdating = True
End If
End Sub

Open in New Window

Select All

Answer : How to refresh DDE links?

Elmura,

I have a hunch that your QueryTable.Refresh call is the problem, but I've cleaned up your code and forced manual calculation which may improve your performance. I assumed that 'runThem' is a global/module-level variable that you use to break out of an infinite loop. Try the attached code and let me know how it works for you.

-mike

NOTE: Make sure the first line (Private Declare Sub Sleep ...) gets put in the top of your vba module (the "declarations" section).

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:



Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Sub Update()
Const FName1 As String = "C:\Program Files\Aus\Aus4\dds.txt"
Const FName2 As String = "C:\Program Files\AUs\Aus4\dds2.txt"
Dim fs As Object, UpdateRange As Range, QueryTableRange As Range, CalcMethod As XlCalculation
Dim QryTbl As QueryTable, Flag As Boolean
 
    On Error GoTo Err_Update
    CalcMethod = Application.Calculation
 
    If runThem Then
        'Create each object only once, instead of each time through the loop '
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set UpdateRange = Worksheets("Place Data").Range("A49:AJ242")
        Set QryTbl = Worksheets("Place Data").Range("EB2").QueryTable
 
        Application.Calculation = xlCalculationManual
 
        Do While runThem
            Application.ScreenUpdating = False
            If Flag Then
                UpdateRange.Replace What:=",29", Replacement:=",30", LookAt:=xlPart, SearchOrder:=xlByRows
            Else
                UpdateRange.Replace What:=",30", Replacement:=",29", LookAt:=xlPart, SearchOrder:=xlByRows
            End If
            Flag = Not Flag
            fs.CopyFile FName1, FName2
            QryTbl.Refresh BackgroundQuery:=False
            Application.Calculate
            Application.ScreenUpdating = True
            Sleep 1000    'Pause for one second '
 
        Loop
    End If
 
 
Exit_Update:
    Application.Calculation = CalcMethod
    Application.ScreenUpdating = True
    Exit Sub
Err_Update:
    MsgBox Err.Description
    Resume Exit_Update
End Sub

Open in New Window

Select All