EXCEL VBA連結oracle資料庫

在vba的編輯環境中,要加入引用,如圖




'====================================================
Sub Select_Sql()
Dim I As Integer
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strCn As String, strSQL As String



'SQL SERVER連結參數
'strCn = "Provider=sqloledb;Server=資料庫server_IP;Database=資料庫名稱;Uid=帳號;Pwd=密碼;"

'oracle SERVER連結參數
strCn = "Provider=MSDAORA.1;User ID=使用者id;Password=使用者密碼;Data Source=連線ip:1521/ORACLE資料庫服務名稱;Persist Security Info=True"

Dim SqlStr As String
Dim IMDSC1 As String '規格
Dim IMSEG1 As String '標準
Dim IMSEG2_1 As String '材質
Dim IMSEG2_2 As String '牙別
Dim IMSEG2_3 As String '印記
Dim IMSEG2_4 As String '表明處理
Dim ASql As String

cn.Open strCn   '建立資料庫連線cn


For I = 2 To 1500
    ASql = ""
    Sql = ""
    If Len(Trim(Sheet2.Cells(I, 2))) > 0 Then
        IMDSC1 = Trim(Sheet2.Cells(I, 2)) '規格
        IMSEG1 = Trim(Sheet2.Cells(I, 3))  '標準
        If IMSEG1 <> "" Then
            ASql = ASql & " AND IMSEG1='" & IMSEG1 & "'"
        End If
       
        IMSEG2_1 = Trim(Sheet2.Cells(I, 4)) '材質
        If IMSEG2_1 <> "" Then
            ASql = ASql & " AND IMSEG2='" & IMSEG2_1 & "'"
        End If
       
        IMSEG2_2 = Trim(Sheet2.Cells(I, 5))  '牙別
        If IMSEG2_2 <> "" Then
            ASql = ASql & " AND IMSEG3='" & IMSEG2_2 & "'"
        End If
       
        IMSEG2_3 = Trim(Sheet2.Cells(I, 6))  '印記
        If IMSEG2_3 <> "" Then
            ASql = ASql & " AND IMSEG4='" & IMSEG2_3 & "'"
        End If
       
        IMSEG2_4 = Trim(Sheet2.Cells(I, 7))  '表明處理
        If IMSEG2_4 <> "" Then
            ASql = ASql & " AND IMSEG5='" & IMSEG2_4 & "'"
        End If
       
        strSQL = "SELECT IMLITM FROM PRODDTA.VF4101E Where IMDSC1='" & IMDSC1 & "'" & ASql
        'strSQL = "SELECT IMLITM FROM VF4101 Where IMDSC1='" & IMDSC1 & "' " & ASql
        'Debug.Print strSQL
        If rs.State = adStateOpen Then rs.Close
        rs.Open strSQL, cn '資料庫run sql指令
        If rs.Fields.Count > 1 Or rs.Fields.Count <= 0 Then
            Sheet2.Cells(I, 1) = "data not only" '資料有2筆以上or沒有資料
        Else
            If rs.BOF And rs.EOF Then
                Sheet2.Cells(I, 1) = "no data"
            Else
                Sheet2.Cells(I, 1) = rs!IMLITM
            End If
        End If
        'rs.Close
    Else
        Sheet2.Cells(I, 1) = I
    End If
Next

If rs.State = adStateOpen Then rs.Close


cn.Close
 
  MsgBox " END~~~", vbInformation, "Find Item No"

End Sub

留言

這個網誌中的熱門文章

java 數字轉字串 字串轉數字

MS sqlServer資料庫移轉至MySQL-->利用MySQL WorkBench

sql server 15023 error [SQL SERVER問題: 使用者、組或角色 '*****' 在當前資料庫中已存在]