Cacher is the code snippet organizer for pro developers

Option Explicit

Public Enum DBTYPE
  NONE
  XLS
  ACCESS
End Enum

Public DataBaseType               As DBTYPE

Public DataSource                 As String
Public SQLServerName              As String
Public SQLDataBaseName            As String
Public ID                         As String
Public Password                   As String

Private mobjConnection            As Object

Private mErrNum                   As Long
Private mErrDes                   As String

Public Enum DBPROPERTY
  adStateClose = 0
  adOpenStatic = 3
End Enum



Private Sub Class_Terminate()


  Call CloseCN
  

End Sub


'==========================================================
'エラー処理
'==========================================================
Public Property Get ErrNum() As Long

  ErrNum = mErrNum

End Property


Public Property Get ErrDes() As String

  ErrDes = mErrDes

End Property



'==========================================================
'DB接続
'==========================================================
Public Function ConnectDB() As Boolean

  Dim strCNString       As String
  Dim strExtension      As String
  

  ConnectDB = False
  
  
  'データベースの種類に応じてConnectStringを用意
    
    Select Case Me.DataBaseType
    
      
      Case DBTYPE.NONE
        '指定忘れ
                
        Err.Description = "データベースタイプ選択エラー"
        
        GoTo ERR_PROC
        
        
      
      Case DBTYPE.XLS
        'エクセルの場合
        
        
        'データソース無指定はエラー
          
          If Me.DataSource = "" Then
          
            Err.Description = "DataSource指定エラー"
            
            GoTo ERR_PROC
          
          End If
      
      
        '拡張子に応じて接続文字列を分岐
          
          strExtension = LCase(Right(Me.DataSource, Len(Me.DataSource) - InStrRev(Me.DataSource, ".")))
              
                
          Select Case True
          
            Case LCase(strExtension) = "xls"
              '2003以前
            
              strCNString = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
            
            
            Case LCase(strExtension) Like "xls?"
              '2007以降
            
              strCNString = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
            
          
          End Select
        
        
          strCNString = strCNString & "Data Source=" & Me.DataSource & ";"
             
      
      
      Case DBTYPE.ACCESS
        'アクセスの場合
        
        
        'データソース無指定はエラー
          
          If Me.DataSource = "" Then
          
            Err.Description = "DataSource指定エラー"
            
            GoTo ERR_PROC
          
          End If
        
        
        '拡張子に応じて接続文字列を分岐
          
          strExtension = LCase(Right(Me.DataSource, Len(Me.DataSource) - InStrRev(Me.DataSource, ".")))
              
                
          Select Case True
          
            Case LCase(strExtension) = "mdb"
              '2003以前
            
              strCNString = "Provider=Microsoft.Jet.OLEDB.4.0;"
            
            
            Case LCase(strExtension) = "accdb"
              '2007以降
              
              strCNString = "Provider=Microsoft.ACE.OLEDB.12.0;"
            
          
          End Select
        
        
          strCNString = strCNString & "Data Source=" & Me.DataSource & ";"
          
          
          If Me.Password <> "" Then
          
            strCNString = strCNString & "JET OLEDB:DataBase Password=" & Me.Password & ";"
          
          End If
        
      
    End Select
    
    
  'コネクション確立
  
    Set mobjConnection = CreateObject("ADODB.Connection")
    
    mobjConnection.Open strCNString
    

    ConnectDB = True
    

  GoTo END_PROC
  
ERR_PROC:

  mErrNum = Err.Number
  mErrDes = Err.Description
  

END_PROC:



End Function


'==========================================================
'SQL実行 - SELECT
'==========================================================
Public Function GetRecordset( _
                        strSQL As String, _
                        objRecordset As Object _
                        )


  GetRecordset = False
  
  
  On Error GoTo ERR_PROC
  
  
  Set objRecordset = CreateObject("ADODB.Recordset")
  
  
  objRecordset.Open strSQL, mobjConnection, adOpenStatic
  
  
  GetRecordset = True
  
  
  GoTo END_PROC
  
ERR_PROC:

  mErrNum = Err.Number
  mErrDes = Err.Description
  

END_PROC:


End Function



'==========================================================
'SQL実行 - SELECT
'==========================================================
Public Function ExecuteDB( _
                        strSQL As String _
                        )


  ExecuteDB = False
  
  
  On Error GoTo ERR_PROC
  
  
  mobjConnection.Execute strSQL
  
  
  ExecuteDB = True
  
  
  GoTo END_PROC
  
ERR_PROC:

  mErrNum = Err.Number
  mErrDes = Err.Description
  

END_PROC:


End Function


'==========================================================
'Recordsetを閉じる
'==========================================================
Public Sub CloseRS( _
                        adoRS As ADODB.Recordset _
                        )


  If Not adoRS Is Nothing Then
  
    If adoRS.State <> adStateClosed Then
    
      adoRS.Close
    
    End If
  
  End If
  

End Sub



'==========================================================
'Connectionを閉じる
'==========================================================
Public Sub CloseCN()


  If Not mobjConnection Is Nothing Then
  
    If mobjConnection.State <> adStateClose Then
    
      mobjConnection.Close
    
    End If
  
  End If


End Sub