Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Import Oracle Table into Excel 1

Status
Not open for further replies.

JohnOm

Programmer
Apr 8, 2004
19
US
Hello all. I'm new to VBA/Oracle and I need your help.

I have the following codes that extract data from Oracle. It does the trick in bringing data from Oracle but would like to limit the output using a worksheet within the current spreadsheet.

Need to filled worksheet "Sample Data" both from Oracle table and Worksheet Data.
Example:

BH_FA WBS DWG_NO Prty P_Date Addr Lvl
MT03564896 CA01 CA01-0S-671017-07-I7 880 20090102 D01 I7

where BH_FA, DWG_NO & SHT Rev will come from Oracle table and WBS Prty P_Date Addr will come from spreasheet called "Data".

Worksheet Data have this
WBS Prty P_Date M_Grp Addr. MTO_LVL
CA01 880 20090102 11 D01 I7
CA01 880 20090102 14 D01 I7

Oracle field must by equal to Worksheet table field.
[Data$]WBS = [BOM_HDR]BH_DL_CD
[Data$]Addr. = [BOM_HDR]BH_ADDR_CD
[Data$]MTO_LVL = [BOM_HDR]BH_MTO_LVL_CD
Code:
Sub OracleExcel()
        
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String
    
    Dim OraDynaSet As Object
    Dim objSession As Object
    Dim objDataBase As Object
    Dim i As Integer
   
    'Create a reference to my database
    Database_Name = "XXXX" ' Enter your  database name here
    User_ID = "User" ' enter your user ID here
    Password = "Password" ' Enter your password here

    'Create a reference to the OO4O dll
    Set objSession = CreateObject("OracleInProcServer.XOraSession")
    Set objDataBase = objSession.OpenDatabase(Database_Name, User_ID & "/" & Password, 0&)
    
    SQLStr = "SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO FROM BOM_HDR WHERE BH_MTO_LVL_CD = 'I7' and BH_ADDR_CD = 'D01' and BH_DL_CD = 'CA01'"
    objDataBase.ExecuteSQL (SQLStr)
    
    'Retrieve the results from Oracle
    Set OraDynaSet = objDataBase.DBCreateDynaset(SQLStr, 0&)
        
    If OraDynaSet.RecordCount > 0 Then
        'There were records retrieved
        OraDynaSet.MoveFirst
        
        'Loop the recordset for returned rows
        For i = 2 To OraDynaSet.RecordCount
        'Put the results in column A, B, D, E and F
                Sheets("Sample Data").Cells(i, 1) = OraDynaSet.Fields(0).Value
                Sheets("Sample Data").Cells(i, 2) = OraDynaSet.Fields(1).Value
                Sheets("Sample Data").Cells(i, 4) = OraDynaSet.Fields(3).Value
                Sheets("Sample Data").Cells(i, 5) = OraDynaSet.Fields(4).Value
                Sheets("Sample Data").Cells(i, 6) = OraDynaSet.Fields(5).Value
                OraDynaSet.MoveNext
        Next i

    End If
    
    Set OraDynaSet = Nothing
    Set objSession = Nothing
    objDataBase.Close
    Set objDataBase = Nothing

End Sub
Thanks in advance.

Regards,
John
 




You are going to have to loop thru the rows on your DATA sheet...
Code:
    Dim r As Range
    
    With Sheets("Data")
       'using a NAMED RANGES based on data headings
        For Each r In .[WBS]
            SQLStr = "SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO "
            SQLStr = SQLStr & "FROM BOM_HDR "
            SQLStr = SQLStr & "WHERE BH_MTO_LVL_CD = '" & .Cells(r.Row, .[MTO_LVL]).Value & "'"
            SQLStr = SQLStr & "  and BH_ADDR_CD = '" & .Cells(r.Row, .[Addr.].Column).Value & "'"
            SQLStr = SQLStr & "  and BH_DL_CD = '" & r.Value & "'"
        Next
    End With


Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 



...of course the loop, you must open a recordset and process the data out.

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Hello Skip and thanks for that.

This is how the code looks like now.

Code:
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")
    
    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=N:\i021 Priority Loader PMDD5800_Test.xls;" & _
            "Extended Properties=""Excel 8.0;HDR=Yes;"";"
    
    objRecordset.Open "Select * FROM [Data$]", _
        objConnection, adOpenStatic, adLockOptimistic, adCmdText
       
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String

    Dim OraDynaSet As Object
    Dim objSession As Object
    Dim objDataBase As Object
    Dim i As Integer
   
    'Create a reference to my database
    Database_Name = "XXXX" ' Enter your  database name here
    User_ID = "Username" ' enter your user ID here
    Password = "Password" ' Enter your password here

    'Create a reference to the OO4O dll
    Set objSession = CreateObject("OracleInProcServer.XOraSession")
    Set objDataBase = objSession.OpenDatabase(Database_Name, User_ID & "/" & Password, 0&)
    
    Dim r As Range
    
    With Sheets("Data")
       'using a NAMED RANGES based on data headings
        For Each r In .[WBS]
            SQLStr = "SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO "
            SQLStr = SQLStr & "FROM BOM_HDR "
            SQLStr = SQLStr & "WHERE BH_MTO_LVL_CD = '" & .Cells(r.row, .[MTO_LVL]).Value & "'"
            SQLStr = SQLStr & "  and BH_ADDR_CD = '" & .Cells(r.row, .[Addr.].Column).Value & "'"
            SQLStr = SQLStr & "  and BH_DL_CD = '" & r.Value & "'"
        Next
    End With
    
    'Retrieve the results from Oracle
    Set OraDynaSet = objDataBase.DBCreateDynaset(SQLStr, 0&)
        
            If OraDynaSet.RecordCount > 0 Then
                'There were records retrieved
                OraDynaSet.MoveFirst
                
                'Loop the recordset for returned rows
                For i = 2 To OraDynaSet.RecordCount
                'Put the results in column A, B, D, E and F
                        Sheets("Sample Data").Cells(i, 1) = OraDynaSet.Fields(0).Value
                        Sheets("Sample Data").Cells(i, 2) = OraDynaSet.Fields(1).Value
                        Sheets("Sample Data").Cells(i, 3) = OraDynaSet.Fields(2).Value
                        Sheets("Sample Data").Cells(i, 4) = OraDynaSet.Fields(3).Value
                        Sheets("Sample Data").Cells(i, 5) = OraDynaSet.Fields(4).Value
                        Sheets("Sample Data").Cells(i, 6) = OraDynaSet.Fields(5).Value
                        OraDynaSet.MoveNext
                Next i
        
            End If
    
    Set objConnection = Nothing
    Set objRecordset = Nothing
    Set OraDynaSet = Nothing
    Set objSession = Nothing
    objDataBase.Close
    Set objDataBase = Nothing

I am getting Type mismatch on line
Code:
SQLStr = SQLStr & "WHERE BH_MTO_LVL_CD = '" & .Cells(r.row, .[MTO_LVL]).Value & "'"

Can you also check if I put your code to the right place in the code?

Thanks again.
John
 



Code:
            SQLStr = SQLStr & "WHERE BH_MTO_LVL_CD = '" & .Cells(r.Row, .[MTO_LVL][b].column[/b]).Value & "'"
use the range reference COLUMN property in the Cells property.

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thanks Skip.

The error went away but now I am not getting any result at all.

I am really confuse.
 



Make sure that you do not have any space padding in the cell data. You might TRIM the cell values.

You might also do a debug.print of your sql variable and then plug that value into a query editor to ascertain if it would actually run.

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Hello Skip. I found the problem.

Next question is...how can I include
Code:
.Cells(r.row, .[WBS].Column).Value
into this query
Code:
SQLStr = "SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO "
 
Your query is only looking for a BH_DL_CD value equal to the last value in the [WBS] range. Try this when building you query:
Code:
    With Sheets("Data")
        'using a NAMED RANGES based on data headings
        Dim SQLInClause As String
        Dim comma As String
        For Each r In .[WBS]
            SQLInClause = SQLInClause & comma & "'" & r.Value & "'"
            comma = ","
        Next
        
        sqlstr = "  SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO " & _
                    " FROM BOM_HDR " & _
                    "WHERE BH_MTO_LVL_CD = '" & .Cells(r.Row, .[MTO_LVL]).Value & "'" & _
                    "  AND BH_ADDR_CD = '" & .Cells(r.Row, .[Addr.].Column).Value & "'" & _
                    "  AND BH_DL_CD IN (" & SQLInClause & ")"
    End With
 
Nevermind the example I just posted. I see you're referencing Range 'r' in other parts of your query. But my initial observation remains that you're overlaying sqlstr each time instead of building it up for each 'r' value; therefore only looking for value in the last row in [WBS].
 




If you're talking about generating an IN (string)...
Code:
Function MakeList(rng As Range) As String
'SkipVought/2005 Jun 13/
'--------------------------------------------------
' Access: N/A
'--------------------------------------------------
'this function returns a single-quoted list that can be used, for instance _
in an IN Clause in SQL _
"WHERE PART_ID IN (" & MakeList([SomeRange]) & ")"
'--------------------------------------------------
    Dim r As Range
    Const TK = "'"
    Const CM = ","
    For Each r In rng
        With r
            MakeList = MakeList & TK & Trim(.Value) & TK & CM
        End With
    Next
    MakeList = Left(MakeList, Len(MakeList) - 1)
End Function


Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Hello all. Thanks for the help.

Below is the current version of this module.
Code:
Sub Oracle2Excel()
    
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")

    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=N:\i021 Priority Loader PMDD5800_Test.xls;" & _
            "Extended Properties=""Excel 8.0;HDR=Yes;"";"
           
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String

    Dim OraDynaSet As Object
    Dim objSession As Object
    Dim objDataBase As Object
    Dim i As Integer
   
    'Create a reference to my database
    Database_Name = "xxxx" ' Enter your  database name here
    User_ID = "Userid" ' enter your user ID here
    Password = "password" ' Enter your password here

    'Create a reference to the OO4O dll
    Set objSession = CreateObject("OracleInProcServer.XOraSession")
    Set objDataBase = objSession.OpenDatabase(Database_Name, User_ID & "/" & Password, 0&)
    
    With Sheets("Data")
        For Each r In Range("A2:A" & _
            Range("A" & Rows.Count).End(xlUp).row)
            'SQLStr = "SELECT count (*)" 'BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO "
            SQLStr = "SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO "
            SQLStr = SQLStr & "FROM BOM_HDR "
            SQLStr = SQLStr & "WHERE BH_MTO_LVL_CD = '" & .Cells(r.row, .[MTO_LVL].Column).Value & "'"
            SQLStr = SQLStr & "  and BH_ADDR_CD = '" & .Cells(r.row, .[Addr.].Column).Value & "'"
            SQLStr = SQLStr & "  and BH_DL_CD = '" & .Cells(r.row, .[WBS].Column).Value & "'"
'Next r
         
    objDataBase.ExecuteSQL (SQLStr)
    
    'Retrieve the results from Oracle
    Set OraDynaSet = objDataBase.DBCreateDynaset(SQLStr, 0&)
        
        If OraDynaSet.RecordCount > 0 Then
            'There were records retrieved
            OraDynaSet.MoveFirst

            'Loop the recordset for returned rows
            For i = 2 To OraDynaSet.RecordCount
            'Put the results in column A, B, D, E and F
                Sheets("Sample Data").Cells(i, 1) = OraDynaSet.Fields(0).Value
                Sheets("Sample Data").Cells(i, 2) = OraDynaSet.Fields(1).Value
                Sheets("Sample Data").Cells(i, 3) = OraDynaSet.Fields(2).Value
                Sheets("Sample Data").Cells(i, 4) = OraDynaSet.Fields(3).Value
                Sheets("Sample Data").Cells(i, 5) = OraDynaSet.Fields(4).Value
                Sheets("Sample Data").Cells(i, 6) = OraDynaSet.Fields(5).Value
                OraDynaSet.MoveNext
            Next i
        End If
        Next r
    End With

    Set objConnection = Nothing
    Set objRecordset = Nothing
    Set OraDynaSet = Nothing
    Set objSession = Nothing
    objDataBase.Close
    Set objDataBase = Nothing

End Sub
It does return 150 records but when I run the query with the full SQL string
Code:
SQLStr = "SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO FROM BOM_HDR WHERE BH_MTO_LVL_CD = 'I7' AND BH_DL_CD = 'CA01' AND BH_ADDR_CD = 'D01'"
I get 5888 records.

This this is the content of sheet "Data"
Code:
WBS	Priority P_Date	  M_Grp	Addr.	MTO_LVL
CA01	880	 20090102 11	D01	I7
CA01	880	 20090102 14	D01	I7

This is the query I have in Access.
Code:
SELECT IPMSPROD_BOM_HDR.BH_SUB_PROJ, IPMSPROD_BOM_HDR.BH_FAST_ACCESS, [Priority Summary].WBS, IPMSPROD_BOM_HDR.BH_DOC_NO, IPMSPROD_BOM_HDR.BH_SHT_NO, IPMSPROD_BOM_HDR.BH_DOC_REV_NO, [Priority Summary].Priority, Format([Priority Summary].P_Date,"yyyymmdd") AS Priority_Date, [Priority Summary].M_Grp, [Priority Summary].Addr
FROM [Priority Summary] LEFT JOIN IPMSPROD_BOM_HDR ON ([Priority Summary].Addr = IPMSPROD_BOM_HDR.BH_ADDR_CD) AND ([Priority Summary].WBS = IPMSPROD_BOM_HDR.BH_DL_CD)
WHERE (((IPMSPROD_BOM_HDR.BH_MTO_LVL_CD)="I7"))
ORDER BY [Priority Summary].WBS, IPMSPROD_BOM_HDR.BH_DOC_NO, [Priority Summary].Priority, [Priority Summary].M_Grp;

This query returns 300 records which means that the code doesn't go to the next record.

Thanks again.
John
 




BTW, check out Data > Import External Data > New database query...

This starts MS Query in Excel. You have a rudimentary QBE Editor, and it's a good way to "try" your sql in Excel.. Unlike MS Access, MS Query uses Oracle sql syntax, just like you need to use in ADO. Great tool!

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Hello all. Thanks for everyone for your effort to help especially to Skip.

I have now resolve the issue (missing counter).

Thanks again.
 
Hello all! I'm back again & need your help.

I am getting Run-time error '424' when I am running my VBA code which similar to whay I have posted here last week.

When I click on debug I am being brought to my string of Select statment.
Code:
SQLStr = SQLStr & "WHERE BH_MTO_LVL_CD = '" & .Cells(r.row, .[MTO_LVL].Column).Value & "'"
SQLStr = SQLStr & "  and BH_SPSY_SYS_CD = '" & .Cells(r.row, .[System].Column).Value & "'"
SQLStr = SQLStr & "  and BH_SERV_CD = '" & .Cells(r.row, .[Service].Column).Value & "'"
SQLStr = SQLStr & "  and BH_LINE_NO = '" & .Cells(r.row, .[P&ID].Column).Value & "'"

I am confuse as this same program is running perfectly on one of my project.

Below is my full code.
Code:
Sub Sub_System()
    
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim SQLStr As String

    Dim OraDynaSet As Object
    Dim objSession As Object
    Dim objDataBase As Object
    Dim r As Range
    Dim i As Integer
    Dim j As Integer

    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")

    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=N:\i021 Sub sytem LoaderTest.xls;" & _
            "Extended Properties=""Excel 8.0;HDR=Yes;"";"
   
    'Create a reference to my database
    Database_Name = "i021" ' Enter your  database name here
    User_ID = "ops$access" ' enter your user ID here
    Password = "access" ' Enter your password here

    'Create a reference to the OO4O dll
    Set objSession = CreateObject("OracleInProcServer.XOraSession")
    Set objDataBase = objSession.OpenDatabase(Database_Name, User_ID & "/" & Password, 0&)
    
    j = 2
    With Sheets("Data")
        For Each r In .Range("A2:A" & _
            .Range("A" & .Rows.Count).End(xlUp).row)
            SQLStr = "SELECT BH_SUB_PROJ, BH_FAST_ACCESS, BH_DL_CD, BH_DOC_NO, BH_SHT_NO, BH_DOC_REV_NO "
            SQLStr = SQLStr & "FROM BOM_HDR "
            SQLStr = SQLStr & "WHERE BH_MTO_LVL_CD = '" & .Cells(r.row, .[MTO_LVL].Column).Value & "'"
            SQLStr = SQLStr & "  and BH_SPSY_SYS_CD = '" & .Cells(r.row, .[System].Column).Value & "'"
            SQLStr = SQLStr & "  and BH_SERV_CD = '" & .Cells(r.row, .[Service].Column).Value & "'"
            SQLStr = SQLStr & "  and BH_LINE_NO = '" & .Cells(r.row, .[P&ID].Column).Value & "'"
        
        objDataBase.ExecuteSQL (SQLStr)
    
        'Retrieve the results from Oracle
        Set OraDynaSet = objDataBase.DBCreateDynaset(SQLStr, 0&)
        
        'MsgBox SQLStr & vbCrLf & OraDynaSet.RecordCount
            
            If OraDynaSet.RecordCount > 0 Then
                'There were records retrieved
                OraDynaSet.MoveFirst
    
                'Loop the recordset for returned rows
                For i = 1 To OraDynaSet.RecordCount
                    Sheets("Sample Data").Cells(j, "A") = OraDynaSet.Fields(0).Value
                    Sheets("Sample Data").Cells(j, "B") = OraDynaSet.Fields(1).Value
                    Sheets("Sample Data").Cells(j, "C") = OraDynaSet.Fields(2).Value
                    Sheets("Sample Data").Cells(j, "D") = OraDynaSet.Fields(3).Value
                    Sheets("Sample Data").Cells(j, "E") = OraDynaSet.Fields(4).Value
                    Sheets("Sample Data").Cells(j, "F") = OraDynaSet.Fields(5).Value
                    Sheets("Sample Data").Cells(j, "G") = Sheets("Data").Cells(r.row, .[System].Column).Value
                    Sheets("Sample Data").Cells(j, "H") = Sheets("Data").Cells(r.row, .[Service].Column).Value
                    Sheets("Sample Data").Cells(j, "I") = Sheets("Data").Cells(r.row, .[Unit].Column).Value
                    Sheets("Sample Data").Cells(j, "J") = Sheets("Data").Cells(r.row, .[P&ID].Column).Value
                    Sheets("Sample Data").Cells(j, "K") = Sheets("Data").Cells(r.row, .[Rating].Column).Value
                    Sheets("Sample Data").Cells(j, "L") = Sheets("Data").Cells(r.row, .[Test_Method].Column).Value
                    Sheets("Sample Data").Cells(j, "M") = Sheets("Data").Cells(r.row, .[MTO_LVL].Column).Value
                    OraDynaSet.MoveNext
                    j = j + 1
                Next i
            End If
        Next r
    End With

    Set objConnection = Nothing
    Set objRecordset = Nothing
    Set OraDynaSet = Nothing
    Set objSession = Nothing
    objDataBase.Close
    Set objDataBase = Nothing

End Sub

Thanks in advance.
John
 




Check your NAMED RANGE Names.

P&ID is NOT a valid Range Name. You will discover that the name is REALLY...
[tt]
P_ID
[/tt]
THAT is the Named Range you must use in your code.


Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thanks Skip - I already found the problem and it is what you said.

I forgot that I have defined the Headers on my Sheets("Data").

Is there a way in making this Headers undefined and use Cell instead and still be able to use
Code:
'" & .Cells(r.row, .[????].Column).Value & "'"
in Select statement?

Regards,
John
 




I sometimes use a technique like this...
Code:
  Dim iColPID as integer
  iColPID = wsSheet.Rows(1).Find("P&ID").Column  'assumes headings in row 1

  Sheets("Sample Data").Cells(j, "J") = Sheets("Data").Cells(r.row, iColPID).Value
or within the For Each r in RowRange...
Code:
For each r in RowRange
  for each c in ColumnRange
    Sheets("Sample Data").Cells(j, "J") = Sheets("Data").Cells(r.row, c.column).Value
  next
next



Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thanks for the suggestion. I will look at it and let you know.

Thanks again.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top