DDClient Control for Visual Basic Using DDClient with VBA

DDClient allows you to overcome some of the limitations imposed by VBA. For example, you can read strings of any length, as is shown in the example code below. The complete Office 95 worksheet can be obtained from the DDClient download area..

Office 97 and later

VBA was enhanced substantially with the release of Microsoft Office 97. From this version on you can place DDClient on a UserForm as you would in Visual Basic. Events are captured when a control is placed on a UserForm.

Office 97 allows Class Modules in which controls can be declared WithEvents and created with CreateObject(). However, we have not succeeded in capturing events in this way. If you know how to do it, please let us know!

Prior to Office 97

The first step is to include a reference to DDClient in the project. You will probably have to browse for the .OCX file. Once this has been done full context sensitive help for the component is available.

Due to the limitations of VBA, you cannot keep a reference to a control in a module variable, as you can keep strings and some other data types. It must be created and do its work within one subroutine or function call.

The following code is cut down from the code module of an Excel workbook. The service, topic and item names are preset to Progman|Progman|Groups, but you can enter any names you wish on the sheet. The complete project puts the data into cells on the worksheet. Excel truncates strings, the project shows how to get all the characters. It is hard work because this version of VBA has no Byte data type.

To download the complete workbook go to the DDClient download area.. To use it the VB5 evaluation DDClient control must installed. To use any of the other versions of the control, change the parameter of the CreateObject call.

Sub Main()

Dim ConvKey As String
Dim IsOK As Boolean
Dim Service As String
Dim Topic As String
Dim Item As String
Dim Length As Long
Dim IntArray() As Integer
Dim I1 As Integer
Dim I2 As Integer
Dim FillString As String

'Check the DDE names are not blank
Sheets("Sheet1").Select
Range("B2").Select
Service = ActiveCell.Value
Range("B3").Select
Topic = ActiveCell.Value
Range("B4").Select
Item = ActiveCell.Value

If Service = "" Or Topic = "" Or Item = "" Then
    MsgBox "You must give the Service, Topic and Item names first"
    Exit Sub
End If

'Clear the returned strings
Range("A7:B100").ClearContents

'Create the DDE client control object and check
Set MyDDE = Nothing
Set MyDDE = CreateObject("DDClDemo.DDECL")

'Stop updating. If done before, the DDClient about box remains on the screen
Application.ScreenUpdating = False

If MyDDE Is Nothing Then
    MsgBox "CreateObject failed"
    Exit Sub
End If

'Initialise the DDClient control and check
IsOK = MyDDE.Initialise()
If Not IsOK Then
    MsgBox "DDE initialisation failed"
    Set MyDDE = Nothing
    Exit Sub
End If

MyDDE.LogFile.Activate ("C:\temp\xltest.log")
MyDDE.LogFile.Options = LOG_ALL

'Connect to the DDE server and check
ConvKey = MyDDE.Connect(Service, Topic)
If ConvKey = MyDDE.FailedReturnString Then
    MsgBox "The service """ & Service & """ and topic """ & _
                    Topic & """ is not available"
    Call MyDDE.Uninitialise
    Set MyDDE = Nothing
    Exit Sub
End If

'Get the data (if available) and destroy the control
Set MyData = Nothing
Set MyData = MyDDE.Conversations(ConvKey).Request(Item, 1000)

Call MyDDE.Disconnect(ConvKey)
MyDDE.LogFile.Deactivate
Call MyDDE.Uninitialise
Set MyDDE = Nothing

If MyData Is Nothing Then
    MsgBox "The data item """ & Item & """ you requested is not available"
    Exit Sub
End If

Sheets("Sheet1").Select

'Because Excel truncates strings, we unpack the data the hard way

Length = MyData.CopyIntegerArray(IntArray())
CurrentGroup = ""
GroupRow = 7
EndFound = False

For Count = 1 To Length
'Get the two characters
I2 = Int(IntArray(Count - 1) / 256)
I1 = IntArray(Count - 1) - (256 * I2)

MakeWord (I1)
MakeWord (I2)

Next Count

Set MyData = Nothing

'Select the item name cell
Application.ScreenUpdating = True
Range("A4").Select
Range("A4").Show

'Fill the dropdown with the items
FillString = "Sheet1!A7:A" & CStr(GroupRow)
With ActiveSheet.DropDowns("Drop Down 26")
    .ListFillRange = FillString
    .ListIndex = 1
    .OnAction = "OnDropSelect"
End With

End Sub

'A subroutine used in unpacking the data into separated lines

Sub MakeWord(ByVal I As Integer)

If EndFound Then Exit Sub
If I = 0 Then
    EndFound = True
    Exit Sub
End If

'At a terminator, put the current word in the next cell, start another
If I < 20 Then
    If CurrentGroup <> "" Then
        Range("A" + CStr(GroupRow)).Select
        ActiveCell.Value = CurrentGroup
        GroupRow = GroupRow + 1
        CurrentGroup = ""
    End If
    Exit Sub
End If

'Not a terminator, add to word
CurrentGroup = CurrentGroup & Chr$(I)

End Sub

Back to the RHA (Minisystems) Ltd home page
http://www.rhaminisys.com