Visual Basic

Private Function IBAAGMQConnect() As String

    Dim CompCode As Long      ' Completion code
    Dim Reason As Long        ' Reason code
    Dim od As MQOD            ' Object descriptor

    Dim CnoCD As MQCNOCD                                ' Connect Options for SSL
    Dim QMgrName As String * MQ_Q_MGR_NAME_LENGTH       ' Pass to MQCONN

    ' Connect to the Queue Manager
    QMgrName = QManagerName




    MQCONN QMgrName, gHcon, CompCode, Reason

    If CompCode <> MQCC_OK Then
        IBAAGMQConnect = "IBAAG MQ: Connection to Queue Manager failed. Reason: " & Reason & " Mgr Name is " & QMgrName
        Exit Function
    Else
        IBAAGMQConnect = "0000"
    End If

End Function

Private Function IBAAGMQOpen(FQueueName As String) As String

    Dim CompCode As Long      ' Completion code
    Dim Reason As Long        ' Reason code
    Dim O_options As Long     ' Open options
    Dim od As MQOD            ' Object descriptor

    ' Open the queue specified in the Queue textbox
    ' if the connect was successful
    If gHcon Then

        MQOD_DEFAULTS od
        od.ObjectName = FQueueName

        ' To specify a queue manager uncomment the
        ' Following line which is (Case-Sensitive)
        od.ObjectQMgrName = QManagerName

        od.AlternateUserId = AlternateUsedId


        O_options = MQOO_OUTPUT + MQOO_INPUT_SHARED + MQOO_ALTERNATE_USER_AUTHORITY

        MQOPEN gHcon, od, O_options, gHobj, CompCode, Reason

        If CompCode <> MQCC_OK Then
            Select Case Reason
                Case Is = 2085
                    IBAAGMQOpen = "IBAAG MQ: Opening of " & Trim(FQueueName) & " failed. " & "ReasonCode = (2085) - MQRC_UNKNOWN_OBJECT_NAME: Check the spelling of the Queue name, which is Case-Sensitive."
                Case Is = 2087
                    IBAAGMQOpen = "IBAAG MQ: Opening of " & Trim(FQueueName) & " failed. " & "ReasonCode = (2087) - MQRC_REMOTE_Q_MGR: Check the spelling of the Queue name, which is Case-Sensitive."
            End Select
            Exit Function
        Else
            IBAAGMQOpen = "0000"
        End If
    Else
        IBAAGMQOpen = "IBAAG MQ: Opening of " & Trim(FQueueName) & " failed. " & Reason
    End If

End Function

Dim nUserID As Long
 Dim sToday  As String
 Dim sUser   As String
 Dim sSQL    As String

 Dim li      As ListItem

 Me.lvMain.ListItems.Clear

 'rsUser.MoveFirst

 Set dbGlob = OpenDatabase(GenPath & "WORORDGB.MDB")
 'Set rsCal = Nothing
 sToday = sDate
 Select Case UCase(sType)

     Case "ALL"            'All

         sSQL = "SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] <> 0 ORDER BY [Date],[UserID],[Start],[WOCounter]"
         Set rsCal = dbGlob.OpenRecordset(sSQL)
         rsCal.MoveLast
         rsCal.MoveFirst

     Case "WO"      'WO

         Set rsCal = dbGlob.OpenRecordset("SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] = " & CInt(Trim(Me.cmbWOID.Text)) & " ORDER BY [Date],[UserID],[Start],[WOCounter]")
         rsCal.MoveLast
         rsCal.MoveFirst

     Case "WR"          'WORKER

         Set rsCal = dbGlob.OpenRecordset("SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] <> 0 AND [UserID]=" & CLng(Me.cmbuserID.Text) & " ORDER BY [Date],[UserID],[Start],[WOCounter]")
         rsCal.MoveLast
         rsCal.MoveFirst

     Case "WRWO"         'Worker - WO

         Set rsCal = dbGlob.OpenRecordset("SELECT * FROM [Accum] WHERE [Type] = 'LABOR' AND [Closed]= 0 AND [WOCounter] = " & CInt(Trim(Me.cmbWOID.Text)) & " AND [UserID]=" & CLng(Me.cmbuserID.Text) & " ORDER BY [Date],[UserID],[Start],[WOCounter]")
         rsCal.MoveLast
         rsCal.MoveFirst

 End Select

 With Me.lvMain
     '.ListItems.Clear
     If rsCal.RecordCount = 0 Then
         Set li = .ListItems.Add(1, "ID" & rsUser.Fields("ID").Value, "Empty", , 4)
         Exit Sub
     End If

     For X = 1 To rsCal.RecordCount

         If IsNull(rsCal.Fields("UserID").Value) Then
             sUser = rsCal.Fields("Desc").Value
         Else
             For Y = 0 To cmbUser.ListCount - 1
                 If CLng(rsCal.Fields("UserID").Value) = CLng(cmbuserID.List(Y)) Then
                     sUser = cmbUser.List(Y)
                     Exit For
                 End If
             Next Y
         End If

         Set li = .ListItems.Add(X, "ID" & rsCal.Fields("Counter").Value, sUser, , 2)
         li.SubItems(1) = Format(rsCal.Fields("Date").Value, "mm/dd/yyyy")
         li.SubItems(2) = Format(rsCal.Fields("Start").Value, "hh:mm ampm")
         li.SubItems(3) = Format(rsCal.Fields("End").Value, "hh:mm ampm")
         li.SubItems(4) = Val(rsCal.Fields("Quantity").Value)
         li.SubItems(5) = rsCal.Fields("WOCounter").Value

         rsCal.MoveNext

     Next X
 End With

'Create the connection string
sConnString = "Provider=SQLOLEDB.1;Data Source=SRV002982;" & _
              "Initial Catalog=HFMDSmartFDM_QMR211;" & _
              "Password=password;Persist Security Info=True;User ID=User"

'Create the Connection and Recordset objects
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

'Open the connection and execute
conn.Open sConnString
Set rs = conn.Execute(CommandString)

    'Check data
    If Not rs.EOF Then
        nRow = nRow + 1
        'Transfer result to WS
        Do While Not rs.EOF
            For Each elem In rs.Fields
                nCol = nCol + 1
                ws.Cells(nRow, nCol) = elem
            Next
        rs.movenext
        Loop
    End If