データベースの接続先選択画面①

ファイル名：frmDB_Connect.frm

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmDB_Connect
   Caption         =   "接続先の変更"
   ClientHeight    =   4815
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   9390
   OleObjectBlob   =   "frmDB_Connect.frx":0000
   StartUpPosition =   1  'オーナー フォームの中央
End
Attribute VB_Name = "frmDB_Connect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmbClose_Click()
    Unload Me
   
End Sub

Private Sub cmbOK_Click()
    Dim i As Integer
    Dim flgCheck As Boolean
    Dim strSql As String
    flgCheck = False
    For i = 1 To lstMain.ListItems.Count
        If lstMain.ListItems(i).Checked = True Then
            flgCheck = True
            Exit For
        End If
     Next i
     If flgCheck = False Then
        MsgBox "接続先をチェックしてください。"
        Exit Sub
     End If
    Call ConnectDB_Access
    For i = 1 To lstMain.ListItems.Count
        If lstMain.ListItems(i).Checked = True Then
            strSql = "UPDATE DB_LIST SET Flg = TRUE WHERE ID = " & Replace(lstMain.ListItems(i).Key, "@", "")
        Else
            strSql = "UPDATE DB_LIST SET Flg = FALSE WHERE ID = " & Replace(lstMain.ListItems(i).Key, "@", "")
        End If
        cn_Access.Execute strSql
    Next i

    Call DissConnectDB_Access

End Sub

Private Sub lstMain_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    Dim i As Integer
    If Item.Checked = True Then
        For i = 1 To lstMain.ListItems.Count
            If Item.Index <> i Then
                lstMain.ListItems(i).Checked = False
            End If
         Next i
    End If

End Sub

Private Sub UserForm_Initialize()
    With lstMain
        ''プロパティ
        .View = lvwReport           ''表示
        .LabelEdit = lvwManual      ''ラベルの編集
        .HideSelection = False      ''選択の自動解除
        .AllowColumnReorder = True  ''列幅の変更を許可
        .FullRowSelect = True       ''行全体を選択
        .Gridlines = True           ''グリッド線
        .CheckBoxes = True
       
        ''列見出し
        .ColumnHeaders.Add , "_Name", "接続先名"
        .ColumnHeaders.Add , "_Instance", "インスタンス"
        .ColumnHeaders.Add , "_User", "ユーザー名"
        .ColumnHeaders.Add , "_Password", "パスワード"
        Call ConnectDB_Access
        Dim strSql As String
        strSql = "SELECT * FROM DB_LIST"
        rs_Access.Open strSql, cn_Access, adOpenDynamic, adLockOptimistic, adCmdText
        '結果取得
        With rs_Access
            Do Until .EOF
                ''1行目
                With lstMain.ListItems.Add
                    .Key = "@" & CStr(rs_Access.Fields("ID"))
                    .Text = rs_Access.Fields("ListName")
                    .SubItems(1) = rs_Access.Fields("Instance")
                    .SubItems(2) = rs_Access.Fields("User")
                    .SubItems(3) = rs_Access.Fields("Password")
                  
                    .Checked = rs_Access.Fields("Flg")
                End With
                .MoveNext

            Loop
       
        End With
        Call DissConnectDB_Access
    End With
   
End Sub