问如何在Excel64位中使用VBA连接到IBM DB2数据源

EN

Option Explicit

Public oDB2Connection As ADODB.Connection
Public zQuery As String
Public zDB2User As String
Public zDB2Pwd As String
Public oRecordSet As ADODB.Recordset

Public iLoginTrials As Integer
Public zTable As String

Sub ConnectDB2()
Dim PS As stPositions
Dim bFirstLogin As Boolean
Dim zStr As String

'//create connection object
Set oDB2Connection = New ADODB.Connection
Set oRecordSet = New ADODB.Recordset


On Error GoTo Errorhandler

iLoginTrials = 0
bFirstLogin = False

With oDB2Connection
    While (.State = 0)
        If (.State = 0) Then
            zDB2User = oMainSheet.Range(RANGE_DB_USR).Value
            zDB2Pwd = oMainSheet.Range(RANGE_DB_PWD).Value
        
            If (AccessLevel < AL_RO) Then
                bFirstLogin = True
                
                With DlgLogin
                    .LoginReadOnly.Visible = True
                    .LoginPM.Visible = True
                    .LoginAdmin.Visible = True
                    .LoginReadOnly.Value = 1
                    .UserName = USER_RO
                    .Password = "member"
                    
                    .StartUpPosition = 1 'posCenterOwner
        
                    PS = PositionForm(WhatForm:=DlgCalendar, AnchorRange:=ActiveSheet.Cells(1, 1))
                    .Top = PS.FrmTop   ' set the Top position of the form
                    .Left = PS.FrmLeft ' set the Left position of the form
                    .Show '//RunUserInterface
                End With
            End If
        End If
                
      
        .ConnectionString = "Driver={IBM DB2 ODBC DRIVER};" _
            & "Database=<myDB>;" _
            & "Hostname=<myHost>;" _
            & "Port=<myPort>;" _
            & "Protocol=TCPIP;" _
            & "Uid=" & zDB2User & ";" _
            & "Pwd=" & zDB2Pwd & ";"
    
        '//set cursor location
        .CursorLocation = adUseClient
    
        '//open database
        .Open
            
        zQuery = "SET CURRENT SCHEMA = 'DCODB2'"
        Message zQuery
        .Execute zQuery, , adExecuteNoRecords
        
        If (.State = 1) Then
            With oMainSheet
                .Unprotect ("*")
                .Range(RANGE_DB_USR).Value = zDB2User
                .Range(RANGE_DB_PWD).Value = zDB2Pwd
                .Protect ("*")
            End With
        End If
        
        '//in case of failure try again to login
        PP iLoginTrials
        If (iLoginTrials > 3) Then
            zStr = "Access to PM database denied"
            MsgBox zStr
            Message zStr
            End
        End If
    Wend '//.State = 0
    
    If (.State And bFirstLogin) Then
        ShowDlgDone "Connection to DB2 successfully established", vbModal
        Message "Userlevel: " & zDB2User
    End If
End With '//oDB2Connection

Exit Sub
    
    
Errorhandler:
    zDB2Pwd = ""
    With oMainSheet
        .Unprotect ("*")
        .Range(RANGE_DB_USR).Value = ""
        .Range(RANGE_DB_PWD).Value = zDB2Pwd
        .Protect ("*")
    End With
    
    MsgBox "Error: " & ERR.Description
    Resume Next
End Sub