DB_Connect_Install

Connects to SQL DB using ADODB, if driver not installed, it will attempt to install driver from provided installation folder(s).
This is the more complex version of DB_Connect
Will execute SQL statement if caller provided sSQL, saves output into oRS object, saves 1 or 0 into DB_Connect settings, also saves count of returned rows into LastTableCount setting if caller set sSQLCount statement.
Used in most of Excel-VBA-based tools where database connection is needed, used to be named DB_Connect_AndOr_Fix


Public

Tested

My Own Work
' Needs
'   mMain module having ...
'      Public oConn As Object
'      Public oRS As Object
'   SettingRead, SettingSave, IsThere, oShellRun1
'   Settings ...
'      00_Var1 = Provider
'      00_Var2 = Server
'      00_Var3 = DB Name
'      00_Var4 = DB user name
'      00_Var5 = Password
'      MSI_x64folder = Path for installation of SQL Server driver for x64 (attached)
'      MSI_x86folder = Path for installation of SQL Server driver for x86 (attached)
'      MSIFile = File name only for installation of SQL Server driver (attached)
'      LogFile = File name to save check output
'      LastTableCount = Count of rows for SQL select executed, if sSQL was provided in parameters.
'      DB_Connected = 1 if db is connected, 0 if not

Sub DB_Connect_Install(Optional sSQL = "", Optional sSQLCount = "")
    SettingSave "DB_Connected", 0
    
    Var1 = SettingRead("00_Var1") ' Provider
    Var2 = SettingRead("00_Var2") ' Server
    Var3 = SettingRead("00_Var3") ' DB
    Var4 = SettingRead("00_Var4") ' Name
    Var5 = SettingRead("00_Var5") ' Pwd
    If Var1 = "" Or Var2 = "" Or Var3 = "" Or Var4 = "" Or Var5 = "" Then
        ' missing connstring, ask for it
        AskDBCredentials 'AppSettings
        Var1 = SettingRead("00_Var1")
        Var2 = SettingRead("00_Var2")
        Var3 = SettingRead("00_Var3")
        Var4 = SettingRead("00_Var4")
        Var5 = SettingRead("00_Var5")
        If Var1 = "" Or Var2 = "" Or Var3 = "" Or Var4 = "" Or Var5 = "" Then
            MsgBox "Missing parameters, please try again...", vbCritical
            Application.Calculation = xlCalculationAutomatic
            End
        End If
    End If
Connection_Start:
    Err.Clear
    On Error Resume Next
    Set mMain.oConn = CreateObject("ADODB.Connection")
    
    ConnString = "PROVIDER=" & Var1 & _
        ";SERVER=" & Var2 & _
        ";DATABASE=" & Var3 & _
        ";USER ID=" & Var4 & _
        ";PASSWORD=" & Var5 & ";"
    mMain.oConn.Open ConnString
    
    If Err.Number = 0 Then GoTo Connection_Pass
    ' Variables
    MSI1 = SettingRead("MSIFile")
    Log1 = SettingRead("LogFile")
    MSILoc1 = SettingRead("MSI_x64folder")
    MSILoc2 = SettingRead("MSI_x86folder")
    If Err.Number = 3706 Or UCase(Left(Err.Description, 24)) = UCase("Provider cannot be found") Then
        ' If error, try to see if the error is because driver not installed
        '   Try install the SQL driver
        DBFix_Loc1 = Replace(MSILoc1, "{{AppPath}}", ThisWorkbook.Path)
        DBFix_Loc2 = Replace(MSILoc2, "{{AppPath}}", ThisWorkbook.Path)
        DBFix_Loc1 = Replace(DBFix_Loc1, "{{Driver}}", Var1)
        DBFix_Loc2 = Replace(DBFix_Loc2, "{{Driver}}", Var1)
        
        ' Install >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>..
        '       msiexec /i "D:\ANmar.Systems\Projects.Individual\TaShee\Resources\SQLNCLI11.x64\sqlncli.msi" _
                    /qr IACCEPTSQLNCLILICENSETERMS=YES Addlocal=all _
                    /Log "D:\ANmar.Systems\Projects.Individual\TaShee\Resources\SQLNCLI11.x64\log.txt"
        ' Uninstall >>>>>>>>>>>>>>
        '       msiexec /x "D:\ANmar.Systems\Projects.Individual\TaShee\Resources\x64\sqlncli.msi" /qr
        '
        ' msiexec /i {{WBPath}}\Attachments1\sqlncli.msi /qn IACCEPTSQLNCLILICENSETERMS=YES /Lime {{WBPath}}\logfile.txt
'        Shell1 = "msiexec /i /a " & DBFix_Loc1 & MSI1 & " /qn IACCEPTSQLNCLILICENSETERMS=YES /Lime " & DBFix_Loc1 & Log1
'        Shell2 = "msiexec /i /a " & DBFix_Loc2 & MSI1 & " /qn IACCEPTSQLNCLILICENSETERMS=YES /Lime " & DBFix_Loc2 & Log1
        Shell1 = "msiexec /i """ & DBFix_Loc1 & MSI1 & """ /qr IACCEPTSQLNCLILICENSETERMS=YES AddLocal=All /Log """ & DBFix_Loc1 & Log1 & """"
        Shell2 = "msiexec /i """ & DBFix_Loc2 & MSI1 & """ /qr IACCEPTSQLNCLILICENSETERMS=YES AddLocal=All /Log """ & DBFix_Loc2 & Log1 & """"
        
        If Not IsThere(MSI1, DBFix_Loc1, True, True) Or Not IsThere(MSI1, DBFix_Loc2, True, True) Then
            Err.Raise 577766, "ANmars", "Missing files for DB Fix setup (" & MSI1 & ")!!!"
            GoTo Connection_Error
        End If
        Return1 = oShellRun1(Shell1, DBFix_Loc1 & Log1)
        If Return1 = 1 Then
            GoTo Connection_Start
        ElseIf Return1 = 2 Then
            Return2 = oShellRun1(Shell2, DBFix_Loc2 & Log1)
            DoEvents
            If Return2 = 1 Then
                GoTo Connection_Start
            Else
'                Err.Raise 577466, "ANmars", "Unexpected error - Could not install SQL Native Client driver in x64 nor in x86"
                GoTo Connection_Error
            End If
        Else
            Err.Raise 577466, "ANmars", "Unexpected error - User/Path unexpected"
            GoTo Connection_Error
        End If
    Else
        GoTo Connection_Error
    End If
    GoTo ByeBye
Connection_Error:
    MsgBox "Error reading table..." & vbCrLf & Err.Number & ": " & Err.Description, vbCritical
    Application.Calculation = xlCalculationAutomatic
    End
Connection_Pass:
    If sSQL > "" Then
        On Error Resume Next
        If sSQLCount > "" Then
            Set mMain.oRS = mMain.oConn.Execute(sSQLCount)
            SettingSave "LastTableCount", mMain.oRS.Fields(0).Value
        End If
        Set mMain.oRS = mMain.oConn.Execute(sSQL)
        If Err.Number = 0 Then
            SettingSave "DB_Connected", 1
        Else
            MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, vbCritical
        End If
    End If
    GoTo ByeBye
ByeBye:
'    Disconnect
    On Error GoTo 0
    Err.Clear
End Sub

Optional sSQL = "", Optional sSQLCount = ""

Views 538 Downloads 164

VBA-Excel Database
ANmarAmdeen
755
Attachments
Revisions

v1.0