Dunk

Private Sub cmd_Confirm_Click()
  If txt_IP.Text = "" Or txt_Account.Text = "" Or txt_PWD.Text = "" Then
    MsgBox "請輸入連線相關資訊"
    Exit Sub
  End If
  GetConnectString ip:=Trim(txt_IP.Text), account:=Trim(txt_Account.Text), pwd:=Trim(txt_PWD.Text)
 

  Dim objConnect As New Connection
     objConnect.Open ThisWorkbook.ConnectString

  Dim objRecordset As New Recordset
   
  With objRecordset
         .CursorLocation = adUseClient
         .Source = SqlCommands.取得線上使用資料庫名稱
         .ActiveConnection = objConnect          '指定所使用的Connection物件
         .Open
  End With
  

  Dim rowCounter As Integer
  rowCounter = 1

  Dim sheetCount As Integer
  sheetCount = objRecordset.RecordCount


  Do While Not objRecordset.EOF
        DataAccessLayer.CollectTotalTableRowCount sheetIndex:=1, dbname:=Trim(objRecordset("name"))
        rowCounter = rowCounter + 1
        objRecordset.MoveNext
  Loop
  Unload Me
End Sub

Private Sub cmd_Reset_Click()
    txt_IP.Text = ""
    txt_Account.Text = ""
    txt_PWD.Text = ""
End Sub

'取得連線字串
Function GetConnectString(ByVal ip As String, ByVal account As String, ByVal pwd As String)
ThisWorkbook.ConnectString = "Provider=SQLOLEDB.1;Data Source=" & ip & ";Password=" & pwd & _
";User ID=" & account & ";Initial Catalog=master"
End Function

Private Sub UserForm_Click()

End Sub

'資料庫存取
Public Sub CollectTotalTableRowCount(ByVal sheetIndex As Integer, ByVal dbname As String)
   
    '宣告資料庫連結的變數
    Dim objConnect2 As New Connection
     objConnect2.Open ThisWorkbook.ConnectString
           
    Dim objRecordset2 As New Recordset
        On Error GoTo DBnameNotExist:
        objRecordset2.Open SqlCommands.查詢單一資料庫表格總筆數(dbname), objConnect2
     
    
    Dim cellName As String
    Dim Counter As Integer
    
    Dim myRange1 As Range
    Dim myRange2 As Range
    Set myRange1 = ThisWorkbook.Sheets(sheetIndex).Range("A1")
    Set myRange2 = myRange1.CurrentRegion
    myRange1.Select
    myRange2.Select
    
    Counter = myRange2.Rows.Count + 1
    
    Set myRange1 = Nothing
    Set myRange2 = Nothing
    
    Do While Not objRecordset2.EOF
          ThisWorkbook.Sheets(sheetIndex).Range("A" + CStr(Counter)).Value = objRecordset2("資料庫名稱")
          ThisWorkbook.Sheets(sheetIndex).Range("B" + CStr(Counter)).Value = objRecordset2("資料表名稱")
          '把儲存格格式設定為文字格式
          ThisWorkbook.Sheets(sheetIndex).Range("C" + CStr(Counter)).Value = "=""" & objRecordset2("筆數") & """"
          Counter = Counter + 1
          objRecordset2.MoveNext
    Loop
    Exit Sub
DBnameNotExist:
        MsgBox "資料庫名稱不存在!"
        Exit Sub
 End Sub
 
 

Function 查詢單一資料庫表格總筆數(ByVal dbname As String)

查詢單一資料庫表格總筆數 = "DECLARE @dbname sysname " & _
" DECLARE @SQLString nvarchar(3000) " & _
" SET @dbname = '" & dbname & "'; " & _
" SET @SQLString = ' " & _
" use [' + @dbname + '];" & _
" SELECT ''' + @dbname + ''' as [資料庫名稱],so.name AS [資料表名稱] " & _
"     , max(si.rows) AS [筆數] " & _
" FROM  " & _
"    sysobjects As so " & _
"    INNER JOIN sysindexes AS si " & _
"        ON object_id(so.name) = si.id " & _
" WHERE " & _
"    so.xtype = ''U'' " & _
" Group BY " & _
"    so.Name " & _
" Order BY " & _
"    [筆數] DESC ; '" & _
" EXEC sp_executesql @SQLString "

End Function


Function 取得線上使用資料庫名稱()

取得線上使用資料庫名稱 = "SELECT row_number() OVER (ORDER BY name) AS rkno" & _
     ", name " & _
" FROM " & _
    "sys.databases " & _
" WHERE " & _
    "state <> 6 " & _
    "AND name NOT IN ('master', 'model', 'msdb', 'tempdb')"

End Function

Public ConnectString As String
Sub CalcDbTableTotalRecordCount()
ActiveSheet.Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.Clear
ThisWorkbook.Sheets(1).Range("A1").Value = "資料庫名稱"
ThisWorkbook.Sheets(1).Range("B1").Value = "資料表名稱"
ThisWorkbook.Sheets(1).Range("C1").Value = "筆數"
SubConnectString.Show
End Sub