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
'====================================================
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
留言
張貼留言