Referencing Database Fields
Try defining thisworkbook like I did below. The problem may lie inthe fact
you have two objects opened and it is confusing the macro.
Sub GetAppCIData()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strWhere As String
Dim strFields As String
Dim strFieldin As String
Dim strTablein As String
Dim strSQL As String
Dim i As Integer
set Tbk = thisworkbook
Set con = New ADODB.Connection
con.Open "Driver={SQL Server};Server=GVS00534\i06,2048;Database=mydb_Pro ;"
strTablein = "dbo.hpsc_application"
strFieldin = "HP_APP_PRTFL_ID, "
strFieldin = strFieldin & "solution_ID, "
strFieldin = strFieldin & "Solution_Alias, "
strFieldin = strFieldin & "Criticality, "
strFieldin = strFieldin & "Short_Description, "
strFieldin = strFieldin & "Lifecycle_Stage_Name, "
strFieldin = strFieldin & "Support_Owner_L2, "
strFieldin = strFieldin & "Support_Owner_L3, "
strFieldin = strFieldin & "SUPPORT_CONTACT, "
strFieldin = strFieldin & "Support_Portfolio_Contact, "
strFieldin = strFieldin & "Planned_Obs_Date, "
strFieldin = strFieldin & "AP_CI_OWN_ASGN_GRP_NM, "
strFieldin = strFieldin & "AP_IT_ASSET_OWN_ORG_HIER1_TX, "
strFieldin = strFieldin & "AP_SUPP_OWN_ORG_HIER1_TX, "
strFieldin = strFieldin & "date_of_last_record_update"
strWhere = "HP_APP_PRTFL_ID = '" & Tbk.Range("EPRID") & "'"
Debug.Print "strWhe " & strWhere
strSQL = "SELECT " & strFieldin & " FROM " & strTablein & " WHERE " & strWhere
Debug.Print "strSQL: " & strSQL
Set rs = con.Execute(strSQL, , 1)
Debug.Print "Lifecycle:" & rs.Fields("Lifecycle_Stage_Name").Value ' <---
Oddity starts here
Debug.Print "L2:" & rs.Fields("Support_Owner_L2").Value ' <--- Oddity ...
Debug.Print "L3:" & rs.Fields("Support_Owner_L3").Value ' <--- Oddity ...
Debug.Print "Contact:" & rs.Fields("SUPPORT_CONTACT").Value ' <--- Oddity
...
With rs
Tbk.Range("Application_Alias") = .Fields("Solution_Alias").Value 'works
fine
Tbk.Range("Asset_Owner_Hierarchy") =
..Fields("AP_IT_ASSET_OWN_ORG_HIER1_TX").Value 'works fine from here on down
Tbk.Range("Support_Owner_Hierarchy") =
..Fields("HP_SUPP_OWN_ORG_HIER1_TX").Value 'ok
Tbk.Range("Criticality") = .Fields("Criticality").Value 'ok
Tbk.Range("Solution_ID") = .Fields("solution_ID").Value 'ok
Tbk.Range("L2_Support") = .Fields("Support_Owner_L2").Value ' does not
work
without debug
Tbk.Range("L3_Support") = .Fields("Support_Owner_L3").Value ' does not
work
without debug
Tbk.Range("Lifecycle") = .Fields("Lifecycle_Stage_Name").Value ' does not
work without debug
Tbk.Range("Support_Contact") = .Fields("SUPPORT_CONTACT").Value ' does
not
work without debug
Tbk.Range("Record_Last_Updated") =
..Fields("date_of_last_record_update").Value 'ok
If .Fields("Planned_Obs_Date").Value < Null Then
Tbk.Range("Obsolete") = .Fields("Planned_Obs_Date").Value ' ok
Else
Tbk.Range("Obsolete") = "No Plan" 'ok
End If
If .Fields("AP_CI_OWN_ASGN_GRP_NM").Value < "" Then
Tbk.Range("CI_Owner_AG") = .Fields("AP_CI_OWN_ASGN_GRP_NM").Value 'ok
Else
Tbk.Range("CI_Owner_AG") = "Missing" 'ok
End If
End With
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
End Sub
"PatK" wrote:
Hi! I have an oddity that perhaps someone might show me what the heck I am
missing. In the following code, where you see the arrows pointing at "Oddity
starts here", is where I am stumped. Basically what I am doing is moving
data from the database fields, to the excel cells. Now, the odd part:
If I do not have the debug statement in the code, then the "subsequent" move
of that same field, to the range referenced excel cell, fails. All of the
rest of them work fine. See code, below.... where it says "oddity starts
here", if I remove those debug statements, then the subsequent assignment of
data from the db fields does not occur for just "some" of the later
statements (and thus, do not appear on the spreadsheet, for which all ranges
are named). What obvious thing am I missing?...cheers, PatK
Sub GetAppCIData()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strWhere As String
Dim strFields As String
Dim strFieldin As String
Dim strTablein As String
Dim strSQL As String
Dim i As Integer
Set con = New ADODB.Connection
con.Open "Driver={SQL Server};Server=GVS00534\i06,2048;Database=mydb_Pro ;"
strTablein = "dbo.hpsc_application"
strFieldin = "HP_APP_PRTFL_ID, "
strFieldin = strFieldin & "solution_ID, "
strFieldin = strFieldin & "Solution_Alias, "
strFieldin = strFieldin & "Criticality, "
strFieldin = strFieldin & "Short_Description, "
strFieldin = strFieldin & "Lifecycle_Stage_Name, "
strFieldin = strFieldin & "Support_Owner_L2, "
strFieldin = strFieldin & "Support_Owner_L3, "
strFieldin = strFieldin & "SUPPORT_CONTACT, "
strFieldin = strFieldin & "Support_Portfolio_Contact, "
strFieldin = strFieldin & "Planned_Obs_Date, "
strFieldin = strFieldin & "AP_CI_OWN_ASGN_GRP_NM, "
strFieldin = strFieldin & "AP_IT_ASSET_OWN_ORG_HIER1_TX, "
strFieldin = strFieldin & "AP_SUPP_OWN_ORG_HIER1_TX, "
strFieldin = strFieldin & "date_of_last_record_update"
strWhere = "HP_APP_PRTFL_ID = '" & Range("EPRID") & "'"
Debug.Print "strWhe " & strWhere
strSQL = "SELECT " & strFieldin & " FROM " & strTablein & " WHERE " & strWhere
Debug.Print "strSQL: " & strSQL
Set rs = con.Execute(strSQL, , 1)
Debug.Print "Lifecycle:" & rs.Fields("Lifecycle_Stage_Name").Value ' <---
Oddity starts here
Debug.Print "L2:" & rs.Fields("Support_Owner_L2").Value ' <--- Oddity ...
Debug.Print "L3:" & rs.Fields("Support_Owner_L3").Value ' <--- Oddity ...
Debug.Print "Contact:" & rs.Fields("SUPPORT_CONTACT").Value ' <--- Oddity
..
With rs
Range("Application_Alias") = .Fields("Solution_Alias").Value 'works fine
Range("Asset_Owner_Hierarchy") =
.Fields("AP_IT_ASSET_OWN_ORG_HIER1_TX").Value 'works fine from here on down
Range("Support_Owner_Hierarchy") =
.Fields("HP_SUPP_OWN_ORG_HIER1_TX").Value 'ok
Range("Criticality") = .Fields("Criticality").Value 'ok
Range("Solution_ID") = .Fields("solution_ID").Value 'ok
Range("L2_Support") = .Fields("Support_Owner_L2").Value ' does not work
without debug
Range("L3_Support") = .Fields("Support_Owner_L3").Value ' does not work
without debug
Range("Lifecycle") = .Fields("Lifecycle_Stage_Name").Value ' does not
work without debug
Range("Support_Contact") = .Fields("SUPPORT_CONTACT").Value ' does not
work without debug
Range("Record_Last_Updated") =
.Fields("date_of_last_record_update").Value 'ok
If .Fields("Planned_Obs_Date").Value < Null Then
Range("Obsolete") = .Fields("Planned_Obs_Date").Value ' ok
Else
Range("Obsolete") = "No Plan" 'ok
End If
If .Fields("AP_CI_OWN_ASGN_GRP_NM").Value < "" Then
Range("CI_Owner_AG") = .Fields("AP_CI_OWN_ASGN_GRP_NM").Value 'ok
Else
Range("CI_Owner_AG") = "Missing" 'ok
End If
End With
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
End Sub
|