VBA从SQL Server获取数据

从SQL Server获取数据时遇到问题。这是代码。VBA从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数据。当我执行它时，会弹出'没有CurrentVersion值'消息。我在代码中看不到任何错误。你能帮我解决这个问题吗？（如果你可以分享你的固定代码，这将是非常好的...）

来源

2017-06-15 jangho yoon

你错过了处理记录集的要点......首先打开记录集，然后从记录集中获取字段，并做你的东西 – maSTAShuFu

只是鞭打了你，告诉你你错了哪里......未经测试...

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

来源

2017-06-15 01:18:22

非常感谢！有用：） –

像这样的东西应该做的工作。

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

来源

2017-06-20 19:36:53 ryguy72

这里有一个更多的想法。比方说，你在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

来源

2017-06-20 19:42:34 ryguy72

VBA从SQL Server获取数据

回答

相关问题