用vba实现一个功能【读取数据库信息，插入到sheet表中】

最新推荐文章于 2024-04-26 17:27:33 发布

英俊的双田

最新推荐文章于 2024-04-26 17:27:33 发布

阅读量549

点赞数

分类专栏： vba 文章标签：经验分享 sql 学习 excel

本文链接：https://blog.csdn.net/m0_56199142/article/details/130214521

版权

vba 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

界面：
在这里插入图片描述
使用说明：
说明书
代码如下：

’model代码：

Dim conn As ADODB.Connection
Dim str As String
Private Function DB_connection(ipAdress As String, DB As String, userName As String, pwd As String) As ADODB.Connection
    On Error GoTo ErrorHandler
    
    Set conn = CreateObject("ADODB.Connection")
    str = "Provider=SQLOLEDB;Persist Security Info=True;User ID= " & userName & ";PWD=" & pwd & ";Initial Catalog=" & DB & ";Data Source=" & ipAdress
    conn.Open str
    
    Exit Function
    
ErrorHandler:
    MsgBox "DB LIAN JIE ERROR"
    End
End Function
Function select_Function(table As String, num As Integer, ipAdress As String, DB As String, userName As String, pwd As String, field As String, condition As String, order As String, location As String) As String
    Dim xRS
    'Dim conn, xRS, str
    'Set conn = CreateObject("ADODB.Connection")
    'str = "Provider=SQLOLEDB;Persist Security Info=True;User ID= " & userName & ";PWD=" & pwd & ";Initial Catalog=" & DB & ";Data Source=" & ipAdress
    
    'conn.Open str
    
    
    Call DB_connection(ipAdress, DB, userName, pwd)
 
    Set xRS = CreateObject("ADODB.RecordSet")
     sSql = "SELECT TOP " & num & " * FROM " & table & " WHERE " & field & " = " & condition & " ORDER BY " & order
    xRS.Open sSql, conn, 1, 1
    
    Sheets(2).Range(location).CopyFromRecordset xRS

    xRS.Close
    conn.Close
    Set xRS = Nothing
    Set conn = Nothing
End Function

Function select_TableName(table As String, ipAdress As String, DB As String, userName As String, pwd As String, rowIndex As Integer, columnIndex As Integer) As String
    Dim rs
    
    'Set conn = CreateObject("ADODB.Connection")
    'str = "Provider=SQLOLEDB;Persist Security Info=True;User ID= " & userName & ";PWD=" & pwd & ";Initial Catalog=" & DB & ";Data Source=" & ipAdress
    'conn.Open str
    
     Call DB_connection(ipAdress, DB, userName, pwd)
     
    
    Set rs = CreateObject("ADODB.RecordSet")
    sSql = "SELECT COLUMN_NAME  FROM information_schema.columns WHERE table_name='" & table & "'ORDER BY ordinal_position;"
    rs.Open sSql, conn, 1, 1
    
    'Dim rowIndex As Integer
   ' Dim columnIndex As Integer

    'rowIndex = 1
    'columnIndex = 1

    For i = 0 To rs.Fields.Count - 1
        'Sheets(2).Cells(rowIndex, 1) = rs.Fields(i).Name
        'columnIndex = rowIndex + 1
    Next i

    Do While Not rs.EOF
        'rowIndex = 1
        For i = 0 To rs.Fields.Count - 1
            Sheets(2).Cells(rowIndex, columnIndex) = rs.Fields(i).Value
                columnIndex = columnIndex + 1
            Next i
            'rowIndex = rowIndex + 1
            rs.MoveNext
    Loop
    
    rs.Close
    conn.Close

End Function
Function SheetExists(sheetName As String) As Boolean
    Dim sht As Worksheet
    SheetExists = False
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name = sheetName Then
            SheetExists = True
            Exit Function
        End If
    Next sht
End Function



Sub test()
  

    'ipAddress = "	"
    'DB = "		"
    'userName = "		"
    'pwd = "	"
    

    'Call getSource1


    table = "EKSSMIX.SSMIX_UPD_RECORD_EXT_XDH"
    field = "PID"
    condition = "88"
    order = "TRANSACTION_DATE DESC"
    location = "A10"
    
     'Call getVarable
    
    Call select_Function(table, ipAddress, DB, userName, pwd, field, condition, order, location)
    
    
End Sub

'sheet代码：

Dim table As String
Dim varableArr(2) As String
Dim sourceArr(3) As String
Dim ipAddress As String
Dim DB As String
Dim userName As String
Dim pwd As String

Dim strJobid As String
Dim intPid As String
Dim strRPT_SHU As String
Dim num As Integer

Dim field As String
Dim condition As String
Dim order As String
Dim location As String

Dim SearchStatus As Integer

Dim getNumber As Integer
Dim str As String
Dim nums As Integer

'岲梡揑曽朄
Function init_method()
    Call judge
    Call getVarable
    Call getSource
    
    'Call common1
    'Call common2
End Function
Private Function common1() As String
    Sheets(2).Range("A1").Value = "EKSSMIX.SSMIX_UPDATE_EVENT"
    Call select_Function("EKSSMIX.SSMIX_UPDATE_EVENT", num, ipAddress, DB, userName, pwd, "JOB_ID", strJobid, "CREATE_DATETIME DESC", "A3")
End Function

Private Function common2() As String
    Dim str As String
    
    num = getNumber
    
    str = "A" & (num + 4)
    condition = "replace(str(" & intPid & ",10),' ','0') "
    Sheets(2).Range(str).Value = "EKSSMIX.SSMIXIDX"
    
    
    str = "A" & (num + 6)
    
    'Call select_Function("EKSSMIX.SSMIXIDX", num, ipAddress, DB, userName, pwd, "PATIENTID", condition, "UPDATEDATETIME DESC", "A16")
    Call select_Function("EKSSMIX.SSMIXIDX", num, ipAddress, DB, userName, pwd, "PATIENTID", condition, "UPDATEDATETIME DESC", str)
End Function

Private Function getVarable() As String
    Sheets(1).Select
    strJobid = Range("c9").Formula
    intPid = Range("c10").Formula
    strRPT_SHU = Range("c11").Formula
    getNumber = Range("c12")
    
     If (strJobid = "") Or (intPid = "") Or (strRPT_SHU = "") Then
        MsgBox ("The parameter cannot be null")
        End
    End If
    
    If (getNumber < 0) Then
        MsgBox ("The parameter error: number < 0")
        End
    ElseIf (getNumber = 0) Then
        getNumber = 10
    End If
    
End Function

Private Function getSource() As String
    Sheets(1).Select
    ipAddress = Range("c3").Formula
    DB = Range("c4").Formula
    userName = Range("c5").Formula
    pwd = Range("c6").Formula
    
    If (pwd = "") Or (ipAddress = "") Or (DB = "") Or (userName = "") = True Then
        MsgBox ("The DB Information cannot be empty")
        End
    End If
    
End Function

Private Function judge() As String
    If SheetExists("job") Then
        Sheets(2).Cells.Clear
   Else
        Sheets.Add after:=ActiveSheet
        Sheets(2).Name = "job"
    End If
End Function
Private Sub super_Sub()
    Call init_method
            num = getNumber
            strJobid = "'" & strJobid & "'"
            strRPT_SHU = "'" & strRPT_SHU & "'"
    
            Call select_TableName("SSMIX_UPDATE_EVENT", ipAddress, DB, userName, pwd, 2, 1)
           ' Call select_TableName("SSMIXIDX", ipAddress, DB, userName, pwd, 15, 1)
            Call select_TableName("SSMIXIDX", ipAddress, DB, userName, pwd, num + 5, 1)
            Call common1
            Call common2
End Sub

Sub changeDataFormate()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("job")
    ws.Cells.NumberFormat = "0"
End Sub

'buttons
Private Sub button1_Click()
    If button1.Value = True Then
        SearchStatus = 1
    End If
End Sub



Private Sub button2_Click()
    If button2.Value = True Then
        SearchStatus = 2
    End If
End Sub

Private Sub button3_Click()
    If button3.Value = True Then
        SearchStatus = 3
    End If
End Sub
Private Sub button4_Click()
    If Button4.Value = True Then
        SearchStatus = 4
    End If
End Sub
Private Sub button5_Click()
    If button5.Value = True Then
        SearchStatus = 5
    End If
End Sub

Private Sub button6_Click()
    If button6.Value = True Then
        SearchStatus = 6
    End If
End Sub

Private Sub button7_Click()
    If button7.Value = True Then
        SearchStatus = 7
    End If
End Sub

Private Sub button8_Click()
    If button8.Value = True Then
        SearchStatus = 8
    End If
End Sub

Private Sub button9_Click()
     If button9.Value = True Then
        SearchStatus = 9
    End If
End Sub
Private Sub button10_Click()
     If button10.Value = True Then
        SearchStatus = 10
    End If
End Sub

Private Sub button11_Click()
     If button11.Value = True Then
        SearchStatus = 11
    End If
End Sub
Private Sub button12_Click()
    If button12.Value = True Then
        SearchStatus = 12
    End If
End Sub

Private Sub button13_Click()
    If button13.Value = True Then
        SearchStatus = 13
    End If
End Sub

Private Sub button14_Click()
    If button14.Value = True Then
        SearchStatus = 14
    End If
End Sub

Private Sub button15_Click()
    If button15.Value = True Then
        SearchStatus = 15
    End If
End Sub

Private Sub button16_Click()
    If button16.Value = True Then
        SearchStatus = 16
    End If
End Sub

Private Sub button17_Click()
    If button17.Value = True Then
        SearchStatus = 17
    End If
End Sub

Private Sub button18_Click()
    If button18.Value = True Then
        SearchStatus = 18
    End If
End Sub

Private Sub button19_Click()
    If button19.Value = True Then
        SearchStatus = 19
    End If
End Sub
Private Sub button20_Click()
    If button20.Value = True Then
        SearchStatus = 20
    End If
End Sub

Private Sub button21_Click()
    If button21.Value = True Then
        SearchStatus = 21
    End If
End Sub

Private Sub button22_Click()
    If button22.Value = True Then
        SearchStatus = 22
    End If
End Sub

Private Sub button23_Click()
    If button23.Value = True Then
        SearchStatus = 23
    End If
End Sub

Private Sub button24_Click()
    If button24.Value = True Then
        SearchStatus = 24
    End If
End Sub

Private Sub CommandButton_Click()

    num = getNumber
    
    str = "A" & (num + num + 7)
    nums = num + num + 8
    
    Select Case SearchStatus
        Case 1
            Call super_Sub
            
            table = "SSMIX_UPD_RECORD_EXT_XDH"
            Sheets(2).Range(str).Value = table
           
            str = "A" & (num + num + 9)
            
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
            
        Case 2
            Call super_Sub
    
            table = "SSMIX_UPD_RECORD_AKJ"
            Sheets(2).Range(str).Value = table
            
            str = "A" & (num + num + 9)
            
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "KJID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
            
        Case 3
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_EXT_XDH"
            Sheets(2).Range(str).Value = table
            
            str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
            
       Case 4
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_API"
            Sheets(2).Range(str).Value = table
            
            str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case 5
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_AUK"
            Sheets(2).Range(str).Value = table
           
           str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "KJID ", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case 6
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_CMV"
            Sheets(2).Range(str).Value = table
            
            str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case 7
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_BKB"
            Sheets(2).Range(str).Value = table
            
            str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case 8
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_NCXH"
            Sheets(2).Range(str).Value = table
           
           str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case 9
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_QIRI2"
            Sheets(2).Range(str).Value = table
           
           str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "RPT_SHU", strRPT_SHU, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case 10
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_QIRI1"
            Sheets(2).Range(str).Value = table
           
           str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "RPT_SHU", strRPT_SHU, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case 11
        
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_XDH2"
            Sheets(2).Range(str).Value = table
            
            str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
        Case Else
            
            Call super_Sub
           
            table = "SSMIX_UPD_RECORD_XDH1"
            Sheets(2).Range(str).Value = table
            
            str = "A" & (num + num + 9)
           
            Call select_TableName(table, ipAddress, DB, userName, pwd, nums, 1)
            Call select_Function(table, num, ipAddress, DB, userName, pwd, "PID", intPid, "TRANSACTION_DATE DESC", str)
            Call changeDataFormate
            
        End Select
        
        
End Sub