티스토리 뷰

VBA에서도 JAVA의 PrepareStatement같은게 없는지 찾아보다가 못 찾아서 만든 코드.

데이터베이스는 mariaDB사용.

 

▼클래스 생성

Option Explicit

'//make by icurfer

Private pstmt As String

Private svr_name As String
Private svr_port As String
Private svr_database_name As String
Private svr_user_name As String
Private svr_password As String
Private svr_conn_info As String
Private Function svrInformation_func() As String
    svr_name = "서버이름"
    svr_port = "포트번호"
    svr_database_name = "데이터베이스이름"
    svr_user_name = "접속계정"
    svr_password = "접속비번"
    svr_conn_info = "Driver={MariaDB ODBC 2.0 Driver};Server=" + svr_name + ";Port=" + svr_port + ";Database=" + _
                    svr_database_name + ";User=" + svr_user_name + ";Password=" + svr_password + ";Option=2;"
    Debug.Print (svr_conn_info)
    
    svrInformation_func = svr_conn_info
    
End Function
Public Function prepareStatment(query_string As String) As String
    'Debug.Print (query_string)
    pstmt = query_string
End Function
Public Function setString(ByVal arry As Collection) As String
    Dim countChar As Integer
    
'    If IsEmpty(arry) Then
'        Debug.Print ("where조건 없음")
'    Else
        Dim i As Integer, j As Integer
        Dim singleChr As String
        Dim tmpString As String
        countChar = Len(pstmt) - Len(Replace(pstmt, "?", ""))
       ' Debug.Print ("개수세기:" & countChar)
        
        '문자열을 돌아가면서 ?를 발견하면 교체할것.
        j = 1
        For i = 0 To Len(pstmt)
            singleChr = Mid(pstmt, i + 1, 1)
            If singleChr = "?" Then
                singleChr = "'" & arry(j) & "'"
                j = j + 1
            End If
            
           ' Debug.Print (singleChr)
            
            tmpString = tmpString + singleChr
        Next i
           ' Debug.Print (setString)
            
        setString = tmpString
    
End Function
Function executeQury_func(query As String) As Variant
'//품목코드 조회기능
    '//Microsoft ActiveX Data Objects 6.1 Library 추가.
    Dim conn As ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim i As Integer
    Dim ws As Worksheet
    
'    Set ws = ThisWorkbook.Worksheets(result_sheet_name)
    Set conn = New ADODB.Connection
    
'    ws.Activate
    '//서버연결정보
    Dim svr_info As String
    
    svr_info = svrInformation_func()
    Debug.Print (svr_info)
            
    conn.ConnectionString = svr_info
    conn.Open
    '//서버연결

    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient

    rs.Open Source:=query, ActiveConnection:=conn, CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly, Options:=adCmdText

    If rs.EOF Then
        Debug.Print "조회조건에 해당하는 자료가 없습니다."
        MsgBox "조회조건에 해당하는 자료가 없습니다."

    Else
'
'        For i = 0 To rs.Fields.count - 1
'            Cells(20, i + 1).Value = rs.Fields(i).Name
'        Next
'
'        rs.MoveFirst
'
'        With ws
'           .Cells(21, 1).CopyFromRecordset rs
'        End With
'
'        'ws.Columns("A:Z").AutoFit
'
    End If
   executeQury_func = rs.GetRows
   rs.Close
   conn.Close

End Function

▼ 모듈에서 호출해서 사용

Option Explicit

Sub test()

Dim ps As New DbControll
Dim i As Integer
Dim squery As String
Dim terms_collection As Collection
Set terms_collection = New Collection
Dim result As Variant

    ps.prepareStatment ("SELECT * FROM WHERE A = ? AND B = ?")
    
        With terms_collection
            .Add "가", "1"
            .Add "나", "2"
        End With
    
    squery = ps.setString(terms_collection)
    
    result = ps.executeQury_func(squery)
    
    Debug.Print (result.Count)

End Sub

'프로그래밍 학습 > 자체제작' 카테고리의 다른 글

Python | 로또 번호 추출 프로그램  (0) 2022.07.14
공지사항
최근에 올라온 글
최근에 달린 댓글
Total
Today
Yesterday
링크
«   2024/09   »
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30
글 보관함