VBA SQL Serverからデータを取得する

Question

SQL Serverからデータを取得するときに問題が発生します。ここにコードがあります。

Private Sub Form_Load() 

Dim blsCritical As Boolean 

'---------------------------------------------- 
ListBox.AddItem "Initializing..." 
'---------------------------------------------- 
Me.Repaint 

'---------------------------------------------- 
ListBox.AddItem "Welcome" 
'---------------------------------------------- 
Me.Repaint 

'---------------------------------------------- 
ListBox.AddItem "Examining your access rights..." 

Call ConnectSQLServer 
'---------------------------------------------- 
Me.Repaint 

ListBox.AddItem strSQL 
'---------------------------------------------- 
ListBox.AddItem "Opening database connection..." 
'---------------------------------------------- 
Me.Repaint 

End Sub 

Sub ConnectSQLServer() 

Dim cmd As ADODB.Command 
Dim conn As ADODB.Connection 
Dim strConn As String 
Dim par As ADODB.Parameter 

Set objMyConn = New ADODB.Connection 
Set objMyRecordset = New ADODB.Recordset 
Dim strSQL As String 

objMyConn.ConnectionString = "DRIVER=SQL Server;SERVER=CHU-AS-0004;DATABASE=RTC_LaplaceD_DEV;Trusted_Connection=Yes;" 
objMyConn.Open 

strSQL = "SELECT [currentVersion], [standardVersion] FROM [dbo].[Version]" 

If currentVersion = "" Then 
    MsgBox ("No currentVersion value") 
ElseIf Not IsNull(currentVersion) Then 
    If currentVersion < standardVersion Then 
     MsgBox ("Upgrade is needed") 
    ElseIf currentVersion = standardVersion Then 
     MsgBox ("PASS") 
    Else 
    End If 
Else 
End If 

Set objMyRecordset.ActiveConnection = objMyConn 
objMyRecordset.Open strSQL 

End Sub 

は、私は、SQL Serverのデータを持っている：

が、私は、SQL Serverからデータを取得することはできません。私が実行すると、 'No CurrentVersion value'というメッセージがポップアップします。自分のコードに間違いはありません。この問題を解決する手助けをしてもらえますか？（固定コードを共有することができれば嬉しいです）

Answer 1

あなたがどこに間違っていたかを示すためにこれを書き出しました...

strSQL = "SELECT [currentVersion], [standardVersion] FROM [dbo].[Version]"  

Set objMyRecordset.ActiveConnection = objMyConn 
objMyRecordset.Open strSQL 

while objMyRecordset.EOF = false 
currentVersion = objMyRecordset!currentVersion 
objMyRecordset.MoveNext 
wend 

If currentVersion = "" Then 
    MsgBox ("No currentVersion value") 
ElseIf Not IsNull(currentVersion) Then 
    If currentVersion < standardVersion Then 
     MsgBox ("Upgrade is needed") 
    ElseIf currentVersion = standardVersion Then 
     MsgBox ("PASS") 
    Else 
    End If 
Else 
End If 

Answer 2

このようなものは、仕事をする必要があります。

Sub GetDataFromADO() 

    'Declare variables' 
     Set objMyconn = New ADODB.Connection 
     Set objMyCmd = New ADODB.Command 
     Set objMyRecordset = New ADODB.Recordset 
     Dim rc As Long 

    'Open Connection' 
     objMyconn.ConnectionString = "Provider=SQLOLEDB;Data Source=SAXAM\SQLEXPRESS;Initial Catalog=AdventureWorks2012; Integrated Security=SSPI;" 

     objMyconn.Open 

    'Set and Excecute SQL Command' 
     Set objMyCmd.ActiveConnection = objMyconn 
     objMyCmd.CommandText = "select * from [Person].[BusinessEntity] " 
     objMyCmd.CommandType = adCmdText 
     objMyCmd.Execute 

    'Open Recordset' 
     Set objMyRecordset.ActiveConnection = objMyconn 
     objMyRecordset.Open objMyCmd 

    'Copy Data to Excel' 
     'ActiveSheet.Range("A1").CopyFromRecordset (objMyRecordset) 
     Application.ActiveCell.CopyFromRecordset (objMyRecordset) 
     rc = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 
     ActiveSheet.Cells(rc + 1, 1).Select 
     'Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Value 
     objMyconn.Close 

End Sub 

Answer 3

もう1つのアイデアがあります。たとえば、A1からのセルの束にSelectステートメントがたくさんあって、シートを動的に追加したり、複数のテーブルのデータ構造を理解するために各シートにサンプルデータをインポートしたりできます。

A1：A3では以下のように仮定します。

SELECT TOP 1000 * FROM [YOUR_DB].[dbo].[YOUR_TABLE1] 
SELECT TOP 1000 * FROM [YOUR_DB].[dbo].[YOUR_TABLE2] 
SELECT TOP 1000 * FROM [YOUR_DB].[dbo].[YOUR_TABLE3] 

以下のスクリプトを実行します。

Sub Download_From_Multiple_Tables() 

'Initializes variables 
Dim cnn As New ADODB.Connection 
Dim rst As New ADODB.Recordset 
Dim ConnectionString As String 
Dim StrQuery As String 
Dim rCell As Range 
Dim rRng As Range 
Dim sht As Worksheet 
Dim LastRow As Long 


Set cnn = New ADODB.Connection 

'For a trusted Connection, where your user ID has permissions on the SQL Server: 
cnn.Open ConnectionString:="Provider=SQLOLEDB.1;" & _ 
"Data Source=" & "YOUR_SERVER_NAME" & ";Initial Catalog=" & "YOUR_DB_NAME" & _ 
";TRUSTED_CONNECTION=YES" 


'Opens connection to the database 
'Timeout error in seconds for executing the entire query; this will run for 15 minutes before VBA timesout, but your database might timeout before this value 
cnn.CommandTimeout = 900 


Set sht = ThisWorkbook.Worksheets("Sheet1") 

'Ctrl + Shift + End 
LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 

    Set rRng = Sheet1.Range("A1:A" & LRow) 
    i = 2 
    For Each rCell In rRng.Cells 

     LPosition = InStrRev(rCell.Value, "[dbo]") + 5 

     ' Name the newly added worksheet, based on the cell value 
     Name = Mid(rCell.Value, LPosition + 1, 99) 

     ' Remove [] characters, as these are not permitted in tab names 
     Name = Replace(Name, "[", "") 
     Name = Replace(Name, "]", "") 

     SheetName = Left(Name, 31) 

     Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SheetName 
     Worksheets(SheetName).Activate 
     StrQuery = rCell.Value 
      'Performs the actual query 
      rst.Open StrQuery, cnn 
      'Dumps all the results from the StrQuery into cell A2 of the first sheet in the active workbook 


      ' Dump field names to the worksheet 
      For intFieldIndex = 0 To rst.Fields.Count - 1 
       ActiveSheet.Cells(1, intFieldIndex + 1).Value = rst.Fields(intFieldIndex).Name 
      Next intFieldIndex 

      ' Dump the records to the worksheet 
      ActiveSheet.Cells(2, 1).CopyFromRecordset rst 
      ' Sheets(i).Range("A1").CopyFromRecordset rst 

      i = i + 1 
      rst.Close 
    Next rCell 

End Sub