PL/SQLを分割プロシージャ化することで、EXCEL VBAから呼び出して使うことが出来ました。
EXCEL VBA でSQLを発行するよりは、若干速いような気がします。
パラメータの設定で苦労しました。(ネットにサンブルが少ない)
Option Explicit
'+------------------------------------------------------------------------------
'| 共通変数
'| 参照設定:Microsoft Activex Data Object X.X Library が必要
'+------------------------------------------------------------------------------
Dim OraCn As ADODB.Connection
Dim OraRs As ADODB.Recordset
Dim OraCmd As ADODB.Command
Public Sub 住所分解()
'================================================================================
' 処理名:住所分解処理
' ①住所を、市区名(県名+市区町村名)、字名(大字名+小字名)、番地、方書に分類する
' ②各々の構成要素こどにコード化する(住所マスタ使用)
' Sheets("ADRS_LIST")の設定
' 1,2行目は、見出し、3行目移行がデータ
' A~C列…SEQ№やキー項目
' 4 D列…分解元住所…入力
' 5 E列…郵便番号(XXX-XXXXの形式)、入力あるときは検索しても置換しない
' 6 F列…都道府県コード、7 G列…市区町村コード、8 H列…大字コード、9 I列…小字コード
' 10 J列…番地コード(番地を5桁、5桁、10桁の0埋め数字列にし合体の20桁)
' 11 K列…都道府県名と市区町村名(政令指定都市の県名省略は選択)
' 12 L列…大字小字名(数字部分は漢数字とする…システムによって違う)
' 13 M列…番地(アラビア数字と番地用文字からなる)
' 14 N列…方書(住所補助のアパート、団地、個人名等)
' Sheets("USER")…ORACLE 接続情報(HOST,SID,USER,PASSWORD)
'================================================================================
Dim i As Integer: i = 3 '行 (3行目が開始行)
Dim j As Integer '文字位置
Dim k As Integer '列
Dim stSQL As String 'SQL文字列
' SQL実行に使用するVB変数
Dim stAdrs As String '住所ワーク
Dim iReigai As Long '例外市区町村
Dim stSikuMei As String '市区町村名
Dim stAzaMei As String '字名
Dim stBanti As String '番地
Dim stKatagaki As String '方書
Dim stYubin As String '郵便番号
Dim iKenCd As Integer '都道府県コード
Dim iSikuCd As Integer '市区町村コード
Dim stOazaCd As String '大字コード
Dim stKoazaCd As String '小字コード
Dim stBantiCd As String '番地コード
Dim DispSw As Boolean '描画有無
'【市区名分割例外配列の設定】
Dim ReiGai(24, 3) As String '市区名分割例外配列
Call DB_CONNECT
stSQL = "SELECT A2.SIKUMEI,TO_CHAR(A2.KEYKENCD),TO_CHAR(A2.KEYSIKUCD),A1.KENMEI"
stSQL = stSQL & " FROM MST_ADRS1 A1,MST_ADRS2 A2"
stSQL = stSQL & " WHERE A2.KEYKENCD = A1.KEYKENCD"
stSQL = stSQL & " AND A2.KEYKENCD || A2.KEYSIKUCD IN (1409,3215,4322,7212,10464,"
stSQL = stSQL & "12203,12219,13361,13362,13363,13364,13381,13382,13401,13402,"
stSQL = stSQL & "13421,17212,21219,23214,24202,29203,29212,29402,34213,41423)"
Set OraRs = OraCn.Execute(stSQL)
j = 0
Do While Not OraRs.EOF
For k = 0 To 3
ReiGai(j, k) = OraRs.Fields(k).Value
Next k
j = j + 1
OraRs.MoveNext
Loop
OraRs.Close
Set OraRs = Nothing
Sheets("ADRS_LIST").Select '住所展開用シート
If MsgBox("実行中画面表示しますか?", vbYesNo) = vbNo Then
Application.ScreenUpdating = False
Sheets("USER").Cells(6, 3).Value = Now()
DispSw = False
Else
Sheets("USER").Cells(6, 2).Value = Now()
DispSw = True
End If
Cells(i, 4).Select
Do While Cells(i, 4).Value <> "" '展開対象住所がある間繰り返し
'【シート値の初期化】
Range(Cells(i, 5), Cells(i, 14)).Value = "" '展開先クリア
stAdrs = Cells(i, 4).Value '住所ワーク
iReigai = -1 '例外市区町村
stSikuMei = "" '市区町村名
stAzaMei = "" '字名
stBanti = "" '番地
stKatagaki = "" '方書
stYubin = "000-0000" '郵便番号
iKenCd = -1 '都道府県コード
iSikuCd = -1 '市区町村コード
stOazaCd = "0000" '大字コード
stKoazaCd = "0000" '小字コード
stBantiCd = "00000000000000000000" '番地コード
'【例外地名】
iReigai = -1
For j = 0 To 24
If InStr(stAdrs, ReiGai(j, 0)) > 0 Then
iReigai = ReiGai(j, 1) * 1000 + ReiGai(j, 2)
Exit For
End If
Next j
'【住所分解】
' PL/SQLブロックからプロシージャを呼ぶ
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_BUNKAI"
.Parameters.Append .CreateParameter("P_ADRS", adVarChar, adParamInput, 100, stAdrs)
.Parameters.Append .CreateParameter("P_REIGAI", adNumeric, adParamInput, 5, iReigai)
.Parameters.Append .CreateParameter("P_SIKUMEI", adVarChar, adParamOutput, 50)
.Parameters.Append .CreateParameter("P_AZAMEI", adVarChar, adParamOutput, 50)
.Parameters.Append .CreateParameter("P_BANTI", adVarChar, adParamOutput, 50)
.Parameters.Append .CreateParameter("P_KATAGAKI", adVarChar, adParamOutput, 100)
.Execute
If Not IsNull(.Parameters("P_SIKUMEI").Value) Then
stSikuMei = .Parameters("P_SIKUMEI").Value '市区町村名
End If
If Not IsNull(.Parameters("P_AZAMEI").Value) Then
stAzaMei = .Parameters("P_AZAMEI").Value '字名
End If
If Not IsNull(.Parameters("P_BANTI").Value) Then
stBanti = .Parameters("P_BANTI").Value '番地
End If
If Not IsNull(.Parameters("P_KATAGAKI").Value) Then
stKatagaki = .Parameters("P_KATAGAKI").Value '方書
End If
End With
Set OraCmd = Nothing
'【市区町村コードの設定】
If stSikuMei <> "" Then
If stSikuMei = Cells(i - 1, 11).Value Then
'同地区連続
iKenCd = CInt(Cells(i - 1, 6).Value) '都道府県コード
iSikuCd = CInt(Cells(i - 1, 7).Value) '市町村コード
Else
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_SIKUCD"
.Parameters.Append .CreateParameter("P_SIKUMEI", adVarChar, adParamInputOutput, 50, stSikuMei) '市区町村名
.Parameters.Append .CreateParameter("P_KENCD", adNumeric, adParamOutput, 2)
.Parameters.Append .CreateParameter("P_SIKUCD", adNumeric, adParamOutput, 3)
.Execute
iKenCd = .Parameters("P_KENCD").Value '都道府県コード
iSikuCd = .Parameters("P_SIKUCD").Value '市町村コード
End With
Set OraCmd = Nothing
End If
Else
iKenCd = -1 '都道府県コード
iSikuCd = -1 '市町村コード
End If
'【字コードの設定】
If stAzaMei <> "" Then
If stAzaMei = Cells(i - 1, 12).Value Then
'同地区連続
stOazaCd = Cells(i - 1, 8).Value '大字コード
stKoazaCd = Cells(i - 1, 9).Value '小字コード
stYubin = Cells(i - 1, 5).Value '郵便番号
Else
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_AZACD"
.Parameters.Append .CreateParameter("P_KENCD", adNumeric, adParamInput, 2, iKenCd) '都道府県コード
.Parameters.Append .CreateParameter("P_SIKUCD", adNumeric, adParamInput, 3, iSikuCd) '市町村コード
.Parameters.Append .CreateParameter("P_AZAMEI", adVarChar, adParamInputOutput, 50, stAzaMei) '字名
.Parameters.Append .CreateParameter("P_YUBIN", adVarChar, adParamInputOutput, 8, stYubin) '郵便番号
.Parameters.Append .CreateParameter("P_BANTI", adVarChar, adParamInputOutput, 50, stBanti) '番地
.Parameters.Append .CreateParameter("P_OAZACD", adVarChar, adParamOutput, 4)
.Parameters.Append .CreateParameter("P_KOAZACD", adVarChar, adParamOutput, 4)
.Execute
If IsNull(.Parameters("P_AZAMEI").Value) Then
stAzaMei = ""
Else
stAzaMei = .Parameters("P_AZAMEI").Value '字名
End If
If IsNull(.Parameters("P_YUBIN").Value) Or _
.Parameters("P_YUBIN").Value = "000-0000" Then
stYubin = ""
Else
stYubin = .Parameters("P_YUBIN").Value '郵便番号
End If
If IsNull(.Parameters("P_BANTI").Value) Then
stBanti = ""
Else
stBanti = .Parameters("P_BANTI").Value '番地
End If
stOazaCd = .Parameters("P_OAZACD").Value '大字コード
stKoazaCd = .Parameters("P_KOAZACD").Value '小字コード
End With
Set OraCmd = Nothing
End If
Else
stYubin = ""
stOazaCd = "0000"
stKoazaCd = "0000"
End If
'【番地のコード化】
If stBanti <> "" Then
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_BANTICD"
.Parameters.Append .CreateParameter("P_BANTI", adVarChar, adParamInput, 60, stBanti) '番地
.Parameters.Append .CreateParameter("P_BANTICD", adVarChar, adParamOutput, 20)
.Execute
If IsNull(.Parameters("P_BANTICD").Value) Then
stBantiCd = "00000000000000000000"
Else
stBantiCd = .Parameters("P_BANTICD").Value '番地コード
End If
End With
Set OraCmd = Nothing
Else
stBantiCd = "00000000000000000000"
End If
Cells(i, 5).Value = stYubin '郵便番号
Cells(i, 6).Value = iKenCd '都道府県コード
Cells(i, 7).Value = iSikuCd '市区町村コード
Cells(i, 8).Value = stOazaCd '大字コード
Cells(i, 9).Value = stKoazaCd '小字コード
Cells(i, 10).Value = stBantiCd '番地コード
Cells(i, 11).Value = stSikuMei '市区町村名
Cells(i, 12).Value = stAzaMei '字名
Cells(i, 13).Value = stBanti '番地
Cells(i, 14).Value = stKatagaki '方書
'次行へ
i = i + 1
If i = Int(i / 10) * 10 Then
' Application.ScreenUpdating = True
Cells(i, 4).Select
' Application.ScreenUpdating = False
End If
Loop
If DispSw = False Then
Application.ScreenUpdating = True
Sheets("USER").Cells(7, 3).Value = Now()
Else
Sheets("USER").Cells(7, 2).Value = Now()
End If
ADRS_SET_EXIT:
OraCn.Close
Set OraCn = Nothing
MsgBox ("住所分解終了!")
Cells(1, 1).Select
End Sub
' ADO : ORACLE DB 接続
Private Sub DB_CONNECT()
If Not OraCn Is Nothing Then Exit Sub
On Err GoTo Err_Han
Dim stPass As String
' パスワードの設定
stPass = Sheets("USER").Cells(4, 2).Value
If stPass = "" Then
stPass = InputBox("USER:" & Sheets("USER").Cells(3, 2).Value & "のPassWord?")
If stPass = "" Then
Exit Sub
END IF
End If
' ORACLE接続
Set OraCn = CreateObject("ADODB.Connection")
OraCn.Open "Provider=MSDAORA;Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=" & _
"(PROTOCOL=TCP)(HOST=" & Sheets("USER").Cells(1, 2).Value & ")(PORT = 1521)))" & _
"(CONNECT_DATA=(SID=" & Sheets("USER").Cells(2, 2).Value & ")));", _
Sheets("USER").Cells(3, 2).Value, stPass
Exit Sub
Err_Han:
OraCn.Close
Set OraCn = Nothing
MsgBox (Err.Description)
Sheets("ADRS_LIST").Select
End Sub
EXCEL VBA でSQLを発行するよりは、若干速いような気がします。
パラメータの設定で苦労しました。(ネットにサンブルが少ない)
Option Explicit
'+------------------------------------------------------------------------------
'| 共通変数
'| 参照設定:Microsoft Activex Data Object X.X Library が必要
'+------------------------------------------------------------------------------
Dim OraCn As ADODB.Connection
Dim OraRs As ADODB.Recordset
Dim OraCmd As ADODB.Command
Public Sub 住所分解()
'================================================================================
' 処理名:住所分解処理
' ①住所を、市区名(県名+市区町村名)、字名(大字名+小字名)、番地、方書に分類する
' ②各々の構成要素こどにコード化する(住所マスタ使用)
' Sheets("ADRS_LIST")の設定
' 1,2行目は、見出し、3行目移行がデータ
' A~C列…SEQ№やキー項目
' 4 D列…分解元住所…入力
' 5 E列…郵便番号(XXX-XXXXの形式)、入力あるときは検索しても置換しない
' 6 F列…都道府県コード、7 G列…市区町村コード、8 H列…大字コード、9 I列…小字コード
' 10 J列…番地コード(番地を5桁、5桁、10桁の0埋め数字列にし合体の20桁)
' 11 K列…都道府県名と市区町村名(政令指定都市の県名省略は選択)
' 12 L列…大字小字名(数字部分は漢数字とする…システムによって違う)
' 13 M列…番地(アラビア数字と番地用文字からなる)
' 14 N列…方書(住所補助のアパート、団地、個人名等)
' Sheets("USER")…ORACLE 接続情報(HOST,SID,USER,PASSWORD)
'================================================================================
Dim i As Integer: i = 3 '行 (3行目が開始行)
Dim j As Integer '文字位置
Dim k As Integer '列
Dim stSQL As String 'SQL文字列
' SQL実行に使用するVB変数
Dim stAdrs As String '住所ワーク
Dim iReigai As Long '例外市区町村
Dim stSikuMei As String '市区町村名
Dim stAzaMei As String '字名
Dim stBanti As String '番地
Dim stKatagaki As String '方書
Dim stYubin As String '郵便番号
Dim iKenCd As Integer '都道府県コード
Dim iSikuCd As Integer '市区町村コード
Dim stOazaCd As String '大字コード
Dim stKoazaCd As String '小字コード
Dim stBantiCd As String '番地コード
Dim DispSw As Boolean '描画有無
'【市区名分割例外配列の設定】
Dim ReiGai(24, 3) As String '市区名分割例外配列
Call DB_CONNECT
stSQL = "SELECT A2.SIKUMEI,TO_CHAR(A2.KEYKENCD),TO_CHAR(A2.KEYSIKUCD),A1.KENMEI"
stSQL = stSQL & " FROM MST_ADRS1 A1,MST_ADRS2 A2"
stSQL = stSQL & " WHERE A2.KEYKENCD = A1.KEYKENCD"
stSQL = stSQL & " AND A2.KEYKENCD || A2.KEYSIKUCD IN (1409,3215,4322,7212,10464,"
stSQL = stSQL & "12203,12219,13361,13362,13363,13364,13381,13382,13401,13402,"
stSQL = stSQL & "13421,17212,21219,23214,24202,29203,29212,29402,34213,41423)"
Set OraRs = OraCn.Execute(stSQL)
j = 0
Do While Not OraRs.EOF
For k = 0 To 3
ReiGai(j, k) = OraRs.Fields(k).Value
Next k
j = j + 1
OraRs.MoveNext
Loop
OraRs.Close
Set OraRs = Nothing
Sheets("ADRS_LIST").Select '住所展開用シート
If MsgBox("実行中画面表示しますか?", vbYesNo) = vbNo Then
Application.ScreenUpdating = False
Sheets("USER").Cells(6, 3).Value = Now()
DispSw = False
Else
Sheets("USER").Cells(6, 2).Value = Now()
DispSw = True
End If
Cells(i, 4).Select
Do While Cells(i, 4).Value <> "" '展開対象住所がある間繰り返し
'【シート値の初期化】
Range(Cells(i, 5), Cells(i, 14)).Value = "" '展開先クリア
stAdrs = Cells(i, 4).Value '住所ワーク
iReigai = -1 '例外市区町村
stSikuMei = "" '市区町村名
stAzaMei = "" '字名
stBanti = "" '番地
stKatagaki = "" '方書
stYubin = "000-0000" '郵便番号
iKenCd = -1 '都道府県コード
iSikuCd = -1 '市区町村コード
stOazaCd = "0000" '大字コード
stKoazaCd = "0000" '小字コード
stBantiCd = "00000000000000000000" '番地コード
'【例外地名】
iReigai = -1
For j = 0 To 24
If InStr(stAdrs, ReiGai(j, 0)) > 0 Then
iReigai = ReiGai(j, 1) * 1000 + ReiGai(j, 2)
Exit For
End If
Next j
'【住所分解】
' PL/SQLブロックからプロシージャを呼ぶ
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_BUNKAI"
.Parameters.Append .CreateParameter("P_ADRS", adVarChar, adParamInput, 100, stAdrs)
.Parameters.Append .CreateParameter("P_REIGAI", adNumeric, adParamInput, 5, iReigai)
.Parameters.Append .CreateParameter("P_SIKUMEI", adVarChar, adParamOutput, 50)
.Parameters.Append .CreateParameter("P_AZAMEI", adVarChar, adParamOutput, 50)
.Parameters.Append .CreateParameter("P_BANTI", adVarChar, adParamOutput, 50)
.Parameters.Append .CreateParameter("P_KATAGAKI", adVarChar, adParamOutput, 100)
.Execute
If Not IsNull(.Parameters("P_SIKUMEI").Value) Then
stSikuMei = .Parameters("P_SIKUMEI").Value '市区町村名
End If
If Not IsNull(.Parameters("P_AZAMEI").Value) Then
stAzaMei = .Parameters("P_AZAMEI").Value '字名
End If
If Not IsNull(.Parameters("P_BANTI").Value) Then
stBanti = .Parameters("P_BANTI").Value '番地
End If
If Not IsNull(.Parameters("P_KATAGAKI").Value) Then
stKatagaki = .Parameters("P_KATAGAKI").Value '方書
End If
End With
Set OraCmd = Nothing
'【市区町村コードの設定】
If stSikuMei <> "" Then
If stSikuMei = Cells(i - 1, 11).Value Then
'同地区連続
iKenCd = CInt(Cells(i - 1, 6).Value) '都道府県コード
iSikuCd = CInt(Cells(i - 1, 7).Value) '市町村コード
Else
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_SIKUCD"
.Parameters.Append .CreateParameter("P_SIKUMEI", adVarChar, adParamInputOutput, 50, stSikuMei) '市区町村名
.Parameters.Append .CreateParameter("P_KENCD", adNumeric, adParamOutput, 2)
.Parameters.Append .CreateParameter("P_SIKUCD", adNumeric, adParamOutput, 3)
.Execute
iKenCd = .Parameters("P_KENCD").Value '都道府県コード
iSikuCd = .Parameters("P_SIKUCD").Value '市町村コード
End With
Set OraCmd = Nothing
End If
Else
iKenCd = -1 '都道府県コード
iSikuCd = -1 '市町村コード
End If
'【字コードの設定】
If stAzaMei <> "" Then
If stAzaMei = Cells(i - 1, 12).Value Then
'同地区連続
stOazaCd = Cells(i - 1, 8).Value '大字コード
stKoazaCd = Cells(i - 1, 9).Value '小字コード
stYubin = Cells(i - 1, 5).Value '郵便番号
Else
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_AZACD"
.Parameters.Append .CreateParameter("P_KENCD", adNumeric, adParamInput, 2, iKenCd) '都道府県コード
.Parameters.Append .CreateParameter("P_SIKUCD", adNumeric, adParamInput, 3, iSikuCd) '市町村コード
.Parameters.Append .CreateParameter("P_AZAMEI", adVarChar, adParamInputOutput, 50, stAzaMei) '字名
.Parameters.Append .CreateParameter("P_YUBIN", adVarChar, adParamInputOutput, 8, stYubin) '郵便番号
.Parameters.Append .CreateParameter("P_BANTI", adVarChar, adParamInputOutput, 50, stBanti) '番地
.Parameters.Append .CreateParameter("P_OAZACD", adVarChar, adParamOutput, 4)
.Parameters.Append .CreateParameter("P_KOAZACD", adVarChar, adParamOutput, 4)
.Execute
If IsNull(.Parameters("P_AZAMEI").Value) Then
stAzaMei = ""
Else
stAzaMei = .Parameters("P_AZAMEI").Value '字名
End If
If IsNull(.Parameters("P_YUBIN").Value) Or _
.Parameters("P_YUBIN").Value = "000-0000" Then
stYubin = ""
Else
stYubin = .Parameters("P_YUBIN").Value '郵便番号
End If
If IsNull(.Parameters("P_BANTI").Value) Then
stBanti = ""
Else
stBanti = .Parameters("P_BANTI").Value '番地
End If
stOazaCd = .Parameters("P_OAZACD").Value '大字コード
stKoazaCd = .Parameters("P_KOAZACD").Value '小字コード
End With
Set OraCmd = Nothing
End If
Else
stYubin = ""
stOazaCd = "0000"
stKoazaCd = "0000"
End If
'【番地のコード化】
If stBanti <> "" Then
Set OraCmd = New ADODB.Command
With OraCmd
.ActiveConnection = OraCn
.CommandType = adCmdStoredProc
.CommandText = "ADRS_BANTICD"
.Parameters.Append .CreateParameter("P_BANTI", adVarChar, adParamInput, 60, stBanti) '番地
.Parameters.Append .CreateParameter("P_BANTICD", adVarChar, adParamOutput, 20)
.Execute
If IsNull(.Parameters("P_BANTICD").Value) Then
stBantiCd = "00000000000000000000"
Else
stBantiCd = .Parameters("P_BANTICD").Value '番地コード
End If
End With
Set OraCmd = Nothing
Else
stBantiCd = "00000000000000000000"
End If
Cells(i, 5).Value = stYubin '郵便番号
Cells(i, 6).Value = iKenCd '都道府県コード
Cells(i, 7).Value = iSikuCd '市区町村コード
Cells(i, 8).Value = stOazaCd '大字コード
Cells(i, 9).Value = stKoazaCd '小字コード
Cells(i, 10).Value = stBantiCd '番地コード
Cells(i, 11).Value = stSikuMei '市区町村名
Cells(i, 12).Value = stAzaMei '字名
Cells(i, 13).Value = stBanti '番地
Cells(i, 14).Value = stKatagaki '方書
'次行へ
i = i + 1
If i = Int(i / 10) * 10 Then
' Application.ScreenUpdating = True
Cells(i, 4).Select
' Application.ScreenUpdating = False
End If
Loop
If DispSw = False Then
Application.ScreenUpdating = True
Sheets("USER").Cells(7, 3).Value = Now()
Else
Sheets("USER").Cells(7, 2).Value = Now()
End If
ADRS_SET_EXIT:
OraCn.Close
Set OraCn = Nothing
MsgBox ("住所分解終了!")
Cells(1, 1).Select
End Sub
' ADO : ORACLE DB 接続
Private Sub DB_CONNECT()
If Not OraCn Is Nothing Then Exit Sub
On Err GoTo Err_Han
Dim stPass As String
' パスワードの設定
stPass = Sheets("USER").Cells(4, 2).Value
If stPass = "" Then
stPass = InputBox("USER:" & Sheets("USER").Cells(3, 2).Value & "のPassWord?")
If stPass = "" Then
Exit Sub
END IF
End If
' ORACLE接続
Set OraCn = CreateObject("ADODB.Connection")
OraCn.Open "Provider=MSDAORA;Data Source=(DESCRIPTION=(ADDRESS_LIST=(ADDRESS=" & _
"(PROTOCOL=TCP)(HOST=" & Sheets("USER").Cells(1, 2).Value & ")(PORT = 1521)))" & _
"(CONNECT_DATA=(SID=" & Sheets("USER").Cells(2, 2).Value & ")));", _
Sheets("USER").Cells(3, 2).Value, stPass
Exit Sub
Err_Han:
OraCn.Close
Set OraCn = Nothing
MsgBox (Err.Description)
Sheets("ADRS_LIST").Select
End Sub