MQSeries and Microsoft ACCESS 1

[LCoder]

Does anyone know if there exists a way to put a string into an MQSeries queue via VBA??? Any help is greatly appreciated. Cheers Lars

 

[kevinf2349]

You can do this using the standard MQ calls and VB.

I am not sure what there is out there in terms of free code samples but this is definately doable.

 

[Wholsea]

I did this in a DTS Package, but it should work for you...

There is some extra stuff in there, but I have a couple of subs and functions that may be of use...

'######################################################################


'Author: Benjamin Buxton
'Development Date: 6-3-04

'Updates
'------------------------------------------------------
'Date Updated By Update
'
'
'
'
'
'------------------------------------------------------



'DO NOT FORGET TO SET A SYSTEM ENVIRONMENT VARIABLE

'Name: MQSERVER
'Value: YOUR QUEUE/TCP/SERVERADDY(PORT)

'This script will not work unless the environment variable is
'set the MQ Client must also be installed


'######################################################################


'Set up the defaults...




QMgr = "QMANAGER" 'The name of the Queue Manager

QName = "QUEUE NAME" 'The name of the queue

' create the first object to access MQAX code
Set MqS = CreateObject("MQAX200.MqSession")

' access the default queue manager

Set qm = MqS.AccessQueueManager(QMgr)

' access a standard queue that should be there, for output and input
set q = qm.AccessQueue(QName, 16 or 1 ) ' 16 - Output, 1 - Input



sub put_data (inst)

' create a new message object
Set pmsg = MqS.AccessMessage()

' prepare data and write it into the message
ps = inst
pmsg.WriteString ps

' set Put Message Options
Set PMO = MqS.AccessPutMessageOptions()
PMO.Options = PMO.Options + MQPMO_NO_SYNCPOINT

' now put the message onto the MQSeries queue
q.Put pmsg, PMO

end sub



function get_data

on error resume next

dim outmsg
outmsg = ""
'Loop through the queue until there are no messages left.
do
Set GMO = MqS.AccessGetMessageOptions()
GMO.Options = GMO.Options + MQGMO_NO_SYNCPOINT

Set gmsg = MqS.AccessMessage()

'If we know the messageid we can use this feature.
'gmsg.MessageId = pmsg.MessageId

' get the message back off the MQSeries queue

q.Get gmsg, GMO
gs = gmsg.ReadString(gmsg.MessageLength)

if err = 0 then
'There was no error... Add the new message to the outgoing buffer.
outmsg = outmsg & gs
end if

loop until err <> 0
outmsg = replace(outmsg," ",vbcrlf)
get_data = outmsg

exit function

End function


sub buildexport (inst)

'Now that we have the data, send it to a file.

Dim objFSO, objTS
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Create the text file
Set objTS = objFSO.CreateTextFile("c:\MQEXPORT.TXT")


objTS.WriteLine(inst)

'Clean up!
objTS.Close
Set objTS = Nothing
Set objFSO = Nothing

end sub





Function Main()

'For testing purposes, lets put some data up there...
'Under production, these calls would not be here. (coment them out.)
put_data("This is a test")

buildexport(get_data) 'Go get the data off of the queue

Main = DTSTaskExecResult_Success
End Function