捐血一袋救人一命

2016年4月8日 星期五

Excel 連接 MS SQL 資料庫VBA巨集程式

Sub connectSQL()
    Dim Conn As ADODB.Connection
    Dim sConnect As String
    Dim strSqlInstance As String
    Dim strSqlDB As String
    Dim strSqlUser As String
    Dim strSqlPWD As String
    ' strSqlInstance = "SERVER_NAME\INSTANCE"
    ' 如果伺服器只有裝一次 SQL,就只要輸入伺服器名稱
    strSqlInstance = "Your SQL Server Name or IP Address"
    strSqlDB = "Your Database Name"
    strSqlUser = "sa"
    strSqlPWD = "password"
    sConnect = "Provider=SQLOLEDB"
    sConnect = sConnect & ";DATA SOURCE=" & strSqlInstance & ";Initial Catalog=" & strSqlDB
   ' 如果把 User ID=...;Password=... 改成 "Integrated Security=sspi;",認證方式就變成 AD 登入帳號
    sConnect = sConnect & ";User ID=" & strSqlUser & ";Password=" & strSqlPWD & ";"
    Set Conn = New ADODB.Connection
    Conn.ConnectionString = sConnect
    Conn.Open
   ' 這裡輸入你處理 SQL 的命令
    Conn.Close
End Sub


實際範例:

Sub GetTableValues()
    Dim Conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim intColCounter As Integer
    Dim sConnect As String
    Dim strSqlInstance As String
    Dim strSqlDB As String
    Dim strSql As String
    Dim strWorkSheet As String
   
    strWorkSheet = "工作表1"
    strSqlInstance = "Your SQL Server Name or IP Address"
    strSqlDB = "Your Database Name"
    strSqlUser = "sa"
    strSqlPWD = "password"

 
    sConnect = "Provider=SQLOLEDB"
    sConnect = sConnect & ";Data Source=" & strSqlInstance & ";Initial Catalog=" & strSqlDB
    sConnect = sConnect & ";User ID=" & strSqlUser & ";Password=" & strSqlPWD & ";"

    Set Conn = New ADODB.Connection
  
' strSql 設定為查詢資料表的 SQL 命令字串 
    strSql = "SELECT * FROM dbo.Asset"

    ' 把資料都放進 rs 資料集合(Recoredset)
    With Conn
        .ConnectionString = sConnect
        .CursorLocation = adUseClient
        .Open
        .CommandTimeout = 0
        Set rs = .Execute(strSql) 
    End With

   
' 清除 Excel 工作表內容
    Worksheets(strWorkSheet).Cells.Clear
    ' 如果 rs 資料集的資料筆數屬性大於 0
    If rs.RecordCount > 0 Then
        ' 從 A1 格,開始輸出欄位名稱(橫向 Row)
        For intColCounter = 0 To rs.Fields.Count - 1
           Worksheets(strWorkSheet).Range("A1").Offset(0, intColCounter) = rs.Fields(intColCounter).Name
        Next
        ' 在 A2 格,一次輸出所有資料內容
       Worksheets(strWorkSheet).Range("A2").CopyFromRecordset rs
    Else
        MsgBox ("找不到數據")
    End If
    rs.Close
    Conn.Close
    Set rs = Nothing
    Set Conn = Nothing
End Sub

反應:

0 意見: