VB code not picking up two other columns :s

[tatendatiffany]

Hie,

So by now i think i am a board regular, i have finally managed to complete my code, so my code picks up thwe sql queries in column AK,AE and AQ and it runs these and displays the results in the specufued columns. But right now instead of picking queries in column Ak and AQ it is excuting for AE again. How do i fix that any ideas i am so close to being done please help

Dim MFcnn As New ADODB.Connection
Dim MFrst As New ADODB.Recordset
Dim SYSRST As New ADODB.Recordset
Dim commandSQL As String
Dim ErrorLog As String
Dim ColDataTypes() As String
Dim username As String
Dim password As String
Dim LoginTries As Integer
Dim Inserts() As String
Global OriginalValue As Variant
Global CurrentStatus As String
Dim f As Integer
Dim r As Long
Dim i As Long
Dim c As Long
Dim ColumnArray As Variant
Dim LongRowString As String
Dim SQL As String
Dim OperationDetail(0, 0) As Variant
Dim TableName As String
Dim PolicyVersionSQL As String
Dim RecordNo As Integer     'this is declaring the variables within the worksheet'
Dim CoverCode As String
Dim ObjectCode As String
Dim ObjectID As String
Dim polNum As String
Dim LogStr As String
Dim step As String
Dim dbNames(4) As String  ' update the value of qCol const if you change this one
Const qCol As Integer = 31  ' value should be 27 + length of dbName array in above line
Const NoofQCol As Integer = 3
Dim oldDBIndex As Integer

Public Function ConnectToDB(username As String, password As String, DatabaseEnv As String) 'recordset'

Range("CredsSaved").Value = "1"
Range("user").Value = username
Range("PWord").Value = password
Range("SaveEnv").Value = DatabaseEnv
Range("CredsSaved,User,PWord,SavedEnv").Font.Color = RGB(255, 255, 255)

If MFcnn.State = 1 Then
    MFcnn.Close
End If
On Error GoTo fErr
With MFcnn
    .Provider = "IBMDADB2.DB2COPY1"
    .Mode = adReadWrite
    .ConnectionString = "Password=" & password & ";Persist Security Info=True;User ID=" & username & ";Data Source=" & DatabaseEnv & ";Mode=ReadWrite;"
    .Open
    If (DatabaseEnv = "") Then
        MsgBox "Database name '" & DatabaseEnv & "' is not valid"
    End If
End With

If MFcnn.State = 1 Then
    ConnectToDB = 0
    Login.Hide
End If
                                     'this logs you in and connects you to the databases'
fContinue:
Exit Function

fErr:
Debug.Print Err.Description
LogStr = LogStr & "    ERROR OCCORD WHILE CONNECTING :      " & Err.Description & vbCrLf
LogStr = LogStr & "         Conn Str ------ :      " & MFcnn.ConnectionString & vbCrLf

MsgBox (Err.Description)
If Err.Number = -2147217843 Then
    LoginTries = LoginTries + 1
End If

If LoginTries = 2 Then
    ConnectToDB = 2
Else
    ConnectToDB = 1
End If
Exit Function

End Function

Public Sub Disconnect()

Range("Creds, CredsSaved").Clear

Set MRrst = Nothing
Set SYSRST = Nothing                                                'this saves your login details'
If MFcnn.State = 1 Then

MFcnn.Close

End If
Set MFcnn = Nothing
End Sub

Function getrecordset(str As String) As String
    'create recordset object
    Dim rs As New ADODB.Recordset
    
    If (MFcnn Is Nothing) Then
        MsgBox "Connection not open"
        LogStr = LogStr & "connection is nothing" & vbCrLf
    End If
    If (MFcnn.State = adStateClosed) Then
        MsgBox "Connection not open"
        LogStr = LogStr & "connection not opened" & vbCrLf
    End If
    
    rs.ActiveConnection = MFcnn
    
    If rs.State = adStateOpen Then rs.Close
    'using the str variable open the recordset
    rs.Source = str
    rs.Open
    'if recordset NOT NULL
    If Not (rs.BOF And rs.EOF) Then        'stores the sql query results
        getrecordset = rs(0)
        'getrecordset = Recordset
    Else
        'getrecordset = "No Result"
        getrecordset = vbNullString
    End If
                                'close and destroy recordset object
    If rs.State = adStateOpen Then rs.Close
    Set rs = Nothing
End Function

Sub getresults()
 On Error GoTo errorhandler
  Dim r As Integer
    Dim c As Integer
    Dim str As String
    Dim SQL As String
    Dim rtnVal As String
    Dim WhichWorksheet As String
    Dim NamedRange As String
    Dim fldCount As String
    Dim rs As Recordset
    Dim cn As ADODB.Connection    'Your loop currently picks up the string from the cells and passes it to the Getrecordset function.
                                'It is in that function that you need to create the recordset
    dbNames(0) = "AIS3AM1"
    dbNames(1) = "AIS3AM3"
    dbNames(2) = "AIS3AM4"
    dbNames(3) = "AIS3AM5"
    dbNames(4) = "AIS3AM7"
    
    'for my testing purpose
    If InStr(1, Range("SavedEnv").Value, "AIS3AM4") > 0 And Now < CDate("2011-06-21") Then Range("SavedEnv").Value = "DSNE"
    
    Call CheckConnection
   
    Set MFrst = Nothing
    If MFcnn.State = 1 Then ' check connection to database
        Dim rslt As VbMsgBoxResult
        rslt = MsgBox("Do you want to execute with all databases?", vbYesNo + vbQuestion)
        Dim dbCount As Integer
        Dim currentQCol As Integer
        For c = 0 To NoofQCol - 1
            For dbCount = 0 To UBound(dbNames)
                'Call ConnectToDB
                LogStr = LogStr & "------------------------------"
                'LogStr = LogStr & " Setting DB Name " & dbNames(dbCount) & vbCrLf
                'Call ConnectToDB(Range("User").Value, Range("PWord").Value, dbNames(dbCount))
                LogStr = LogStr & " Connection State " & MFcnn.State & vbCrLf
                LogStr = LogStr & " Connection String " & MFcnn.ConnectionString & vbCrLf
                LogStr = LogStr & "------------------------------"
                For r = 2 To 39
                    LogStr = LogStr & "------------------------------" & vbCrLf
                    LogStr = LogStr & " Row " & r & " qCol " & c & ", dbIndex " & dbCount & vbCrLf
                    LogStr = LogStr & "------------------------------" & vbCrLf
                    currentQCol = qCol + (UBound(dbNames) + 2) * c
                    If Sheet1.Cells(r, currentQCol).Value <> "" Then
                        str = Sheet1.Cells(r, qCol).Value
                        LogStr = LogStr & str & vbCrLf
                        If (rslt = vbYes) Then
                            str = Replace(str, "AIS3AM1.", dbNames(dbCount) & ".", , , vbTextCompare)
                            LogStr = LogStr & str & vbCrLf
                        End If
                        rtnVal = getrecordset(str)
                        LogStr = LogStr & rtnVal & vbCrLf
                        Sheet1.Cells(r, (currentQCol - UBound(dbNames) - 1 + dbCount)).Value = rtnVal
                    Else
                        LogStr = LogStr & " Cell is empty so skipping record " & vbCrLf
                    End If
                Next r
            Next dbCount
        Next c
        If MFcnn.State = adStateOpen Then MFcnn.Close
    Else
        LogStr = LogStr & "------------------------------" & vbCrLf
        LogStr = LogStr & " SKIPPING ALL CAUSE CONNECTION IS NOT MADE " & vbCrLf
        LogStr = LogStr & "------------------------------" & vbCrLf
        MsgBox "Connection not open. Skipping all queries", vbExclamation
    End If
    

    GoTo ExitSub
errorhandler:
    LogStr = LogStr & "    ERROR OCCURRED :      " & Err.Description & vbCrLf
    If MsgBox("An error occurred while performing action" & vbCrLf & vbCrLf & Err.Description & vbCrLf & vbCrLf & "Do you want to continue?", vbCritical + vbOKCancel, Err.Source) = vbOK Then
        rtnVal = vbNullString
        Resume Next
    End If
    If MFcnn.State = adStateOpen Then MFcnn.Close
    
ExitSub:

    
    Open ThisWorkbook.Path & IIf(Right(ThisWorkbook.Path, 1) = "\", "", "\") & "LOg.file" For Append As #99
    Print #99, "***********************************************************"
    Print #99, "****   LOG STATED AT " & Now & "   ******** v2.10 "
    Print #99, "***********************************************************"
    Print #99, "Conn Str : " & MFcnn.ConnectionString & vbCrLf
    Print #99, "***********************************************************"
    Print #99, LogStr
    Close #99
    MsgBox "Log File saved at '" & ThisWorkbook.Path & IIf(Right(ThisWorkbook.Path, 1) = "\", "", "\") & "Log.file" & "'"
End Sub




Static Sub CheckConnection()
    MsgBox "Establishing connection"
    If MFcnn.State = 0 Then
        If Range("User").Value = "" Or Range("PWord").Value = "" Or Range("SavedEnv").Value = "" Then
            Login.Show
           TxtUsername.Value = ""
           TxtPassword.Value = ""
        Else
            Call ConnectToDB(Range("User").Value, Range("PWord").Value, Range("SavedEnv").Value)
        End If
    Else

        On Error GoTo fErr
        Set MFrst = Nothing
        MFrst.Open sqlString, MFcnn, adOpenStatic, adLockReadOnly
    
    End If
    If MFcnn.State = adStateOpen Then
        MsgBox "Connection Established successfully!"
    Else
        MsgBox "Connection not open. Please try again to connect"
    End If
    
    Exit Sub
    
fErr:

Debug.Print Err.Description     'checks users login and stores the details'

If Range("CredsSaved").Value = "1" Then
    Call ConnectToDB(Range("User").Value, Range("PWord").Value, Range("SaveEnv").Value)
Else
    Login.Show
End If


End Sub

[Doogle]

Should this

str = Sheet1.Cells(r, qCol).Value

be this

str = Sheet1.Cells(r, CurrentQCol).Value

?
I don't see where you're changing qCol within the loops

[tatendatiffany]

hie,

thank you very much that was what was missing. Thanks again you saved me a lot of time.

Regards