Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Referencing Database Fields
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Referencing Database Fields
Thanks, Joel: I did give it a go, but no joy. I received a message that
states: Object doesn't support this property or method. FYI, just to ensure I followed your instructions, I added these lines up at top: Dim tbk As Workbook Set tbk = ThisWorkbook tbk.Range("Application_Alias") = .Fields("Solution_Alias").Value It fails once it hits the very first use of tbk. What do you think? thanks! Patk Then, here is an example of how I changed one of the assignment statements: "Joel" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Referencing Database Fields
A range Name ("Application_Alias") is a workbook object dso I didn't think
anything else s needed. I guess I was wrong. from Set tbk = ThisWorkbook to Set tbk = ThisWorkbook.Application "PatK" wrote: Thanks, Joel: I did give it a go, but no joy. I received a message that states: Object doesn't support this property or method. FYI, just to ensure I followed your instructions, I added these lines up at top: Dim tbk As Workbook Set tbk = ThisWorkbook tbk.Range("Application_Alias") = .Fields("Solution_Alias").Value It fails once it hits the very first use of tbk. What do you think? thanks! Patk Then, here is an example of how I changed one of the assignment statements: "Joel" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Referencing Database Fields
Ok...I did give that a shot:
Set tbk = ThisWorkbook.Application but I get a type mismatch on the statement. Here is how tbk is dim'd: Dim tbk As Workbook I appreciate your help!!!! I have re-entered the code, as it is now: 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 Dim tbk As Workbook Set tbk = ThisWorkbook.Application ClearForm Set con = New ADODB.Connection con.Open "Driver={SQL Server};Server=GVS00534\i06,2048;Database=Apate_Pr o;" 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 & "HP_CI_OWN_ASGN_GRP_NM, " strFieldin = strFieldin & "HP_IT_ASSET_OWN_ORG_HIER1_TX, " strFieldin = strFieldin & "HP_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 starts here 'Debug.Print "L3:" & rs.Fields("Support_Owner_L3").Value ' <--- Oddity starts here 'Debug.Print "Contact:" & rs.Fields("SUPPORT_CONTACT").Value ' <--- Oddity starts here With rs tbk.Range("Application_Alias") = .Fields("Solution_Alias").Value 'works fine tbk.Range("Asset_Owner_Hierarchy") = ..Fields("HP_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("HP_CI_OWN_ASGN_GRP_NM").Value < "" Then tbk.Range("CI_Owner_AG") = .Fields("HP_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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Referencing Database Fields
I tried re-coding those lines to as follows:
Dim tbk As Worksheet Set tbk = ThisWorkbook.Worksheets("CI Data") ' CI Data is the worksheet name and while that eliminate the error, I am back to square one, with those same 4 fields not being populated. Anyone have a good snippet of code that accessed a DB from Excel and populates cells? Thanks, again! Patk "PatK" wrote: Ok...I did give that a shot: Set tbk = ThisWorkbook.Application but I get a type mismatch on the statement. Here is how tbk is dim'd: Dim tbk As Workbook I appreciate your help!!!! I have re-entered the code, as it is now: 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 Dim tbk As Workbook Set tbk = ThisWorkbook.Application ClearForm Set con = New ADODB.Connection con.Open "Driver={SQL Server};Server=GVS00534\i06,2048;Database=Apate_Pr o;" 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 & "HP_CI_OWN_ASGN_GRP_NM, " strFieldin = strFieldin & "HP_IT_ASSET_OWN_ORG_HIER1_TX, " strFieldin = strFieldin & "HP_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 starts here 'Debug.Print "L3:" & rs.Fields("Support_Owner_L3").Value ' <--- Oddity starts here 'Debug.Print "Contact:" & rs.Fields("SUPPORT_CONTACT").Value ' <--- Oddity starts here With rs tbk.Range("Application_Alias") = .Fields("Solution_Alias").Value 'works fine tbk.Range("Asset_Owner_Hierarchy") = .Fields("HP_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("HP_CI_OWN_ASGN_GRP_NM").Value < "" Then tbk.Range("CI_Owner_AG") = .Fields("HP_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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Referencing Database Fields
Hey Joel...or anyone...any one have any ideas why this code is not
working...why I have to enter a debug.print statement (or some other access) before an assignment can be made from a database field to a named cell in an excel file? I am totally stuck. If it is not possible to truly do SQL/ODBC db access from Excel, using VBA, that's fine, but my impression was that this should work. Hard to find folks that even have done it, so am beginning to wonder if there was a reason for that? Thanks, Patk "Joel" wrote: A range Name ("Application_Alias") is a workbook object dso I didn't think anything else s needed. I guess I was wrong. from Set tbk = ThisWorkbook to Set tbk = ThisWorkbook.Application "PatK" wrote: Thanks, Joel: I did give it a go, but no joy. I received a message that states: Object doesn't support this property or method. FYI, just to ensure I followed your instructions, I added these lines up at top: Dim tbk As Workbook Set tbk = ThisWorkbook tbk.Range("Application_Alias") = .Fields("Solution_Alias").Value It fails once it hits the very first use of tbk. What do you think? thanks! Patk Then, here is an example of how I changed one of the assignment statements: "Joel" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Database fields in Excel? | New Users to Excel | |||
Referencing Fields in MS Project | Excel Programming | |||
Pulling date from 1 ws to another while referencing 2 fields | Excel Discussion (Misc queries) | |||
Fields in access database | Excel Programming | |||
Fields in access database | Excel Programming |