我正在开发一个VBA宏，它连接到我在SQL Server上的数据库并运行一些查询并将结果保存在CSV文件中...它只在查询返回数据时工作正常但我有几天查询没有＆＃ 39; t返回任何结果，只是一个空表。我根据检查日期做了一个临时解决方案，并根据宏运行该查询或不...我想在我的代码中以其他方式进行，这样我就不需要每次手动更改日期。 ..
我尝试了这些解决方案：
If (objMyRecordset.EOF = False) Or (objMyRecordset.BOF = False) Then
也是这个
If objMyRecordset.RecordCount <> 0 Then
但问题是我的Recordset为空，因为查询没有返回任何行，因此它显示objMyRecordset.Open中的错误
我想添加一行代码，例如：
'// Pseudo Code
If (the query doesn't return result) Then
( just the headers will be save on my file )
Else
(do the rest of my code)
End If
这是我的代码。有什么建议吗？非常感谢你。
Sub Load_after_cutoff_queryCSV()
Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim objMyRecordset As ADODB.Recordset
Dim fields As String
Dim i As Integer
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
'Open Connection
objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=*****;User ID=*****;Password=*****;"
objMyConn.Open
'Set and Excecute SQL Command
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = "SELECT * FROM [vw_X86_LOAD_AFTER_CUTOFF_REPORT_GAMMA]"
objMyCmd.CommandType = adCmdText
'Open Recordset
Set objMyRecordset.Source = objMyCmd
objMyRecordset.Open
Workbooks.Open Filename:="C:\Reports\load_after_cutoff_postGamma.csv"
Workbooks("load_after_cutoff_postGamma.csv").Sheets("load_after_cutoff_postGamma").Activate
ActiveSheet.Range("A2").CopyFromRecordset objMyRecordset
For i = 0 To objMyRecordset.fields.Count - 1
Worksheets("load_after_cutoff_postGamma").Cells(1, i + 1) = objMyRecordset.fields(i).name
Next i
Workbooks("load_after_cutoff_postGamma.csv").Sheets("load_after_cutoff_postGamma").Cells.EntireColumn.AutoFit
Workbooks("load_after_cutoff_postGamma.csv").Close SaveChanges:=True
MsgBox "Your file has been saved as load_after_cutoff_postGamma.csv"
答案 0 :(得分：2)
如果您在连接服务器时遇到问题，则原因如下：
向服务器发送导致空记录集的查询不是导致ADODB.Connection失败的原因。
以下是一些代码，您可以在第一步中尝试调试连接，然后在第二步中调试查询：
Option Explicit
Public Sub tmpSO()
Dim strSQL As String
Dim strServer As String
Dim strDatabase As String
Dim OutMail As Outlook.MailItem
Dim rstResult As ADODB.Recordset
Dim conServer As ADODB.Connection
Dim OutApp As Outlook.Application
strServer = "."
strDatabase = "master"
Set conServer = New ADODB.Connection
conServer.ConnectionString = "PROVIDER=SQLOLEDB; " _
& "DATA SOURCE=" & strServer & ";" _
& "INITIAL CATALOG=" & strDatabase & ";" _
& "User ID='UserNameWrappedInSingleQuotes'; " _
& "Password='PasswordWrappedInSingleQuotes'; "
On Error GoTo SQL_ConnectionError
conServer.Open
On Error GoTo 0
strSQL = "set nocount on; "
strSQL = strSQL & "select * "
strSQL = strSQL & "from sys.tables as t "
strSQL = strSQL & "where t.name = ''; "
Set rstResult = New ADODB.Recordset
rstResult.ActiveConnection = conServer
On Error GoTo SQL_StatementError
rstResult.Open strSQL
On Error GoTo 0
If Not rstResult.EOF And Not rstResult.BOF Then
ThisWorkbook.Worksheets(1).Range("A1").CopyFromRecordset rstResult
' While Not rstResult.EOF And Not rstResult.BOF
' 'do something
' rstResult.MoveNext
' Wend
Else
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms675546(v=vs.85).aspx
Select Case conServer.State
'adStateClosed
Case 0
MsgBox "The connection to the server is closed."
'adStateOpen
Case 1
MsgBox "The connection is open but the query did not return any data."
'adStateConnecting
Case 2
MsgBox "Connecting..."
'adStateExecuting
Case 4
MsgBox "Executing..."
'adStateFetching
Case 8
MsgBox "Fetching..."
Case Else
MsgBox conServer.State
End Select
End If
Set rstResult = Nothing
Exit Sub
SQL_ConnectionError:
MsgBox "Couldn't connect to the server. Please make sure that you have a working connection to the server."
Set OutApp = New Outlook.Application
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Subject = "Problems connecting to database '" & strDatabase & "' hosted on the server '" & strServer & "'"
.HTMLBody = "<span style=""font-size:10px"">---Automatically generated Error-Email---" & _
"</span><br><br>Error report from the file '" & _
"<span style=""color:blue"">" & ThisWorkbook.Name & _
"</span>' located and saved on '<span style=""color:blue"">" & _
ThisWorkbook.Path & "</span>'.<br>" & _
"Excel is not able to establish a connection to the server. Technical data to follow." & "<br><br>" & _
"Computer Name: <span style=""color:green;"">" & Environ("COMPUTERNAME") & "</span><br>" & _
"Logged in as: <span style=""color:green;"">" & Environ("USERDOMAIN") & "/" & Environ("USERNAME") & "</span><br>" & _
"Domain Server: <span style=""color:green;"">" & Environ("LOGONSERVER") & "</span><br>" & _
"User DNS Domain: <span style=""color:green;"">" & Environ("USERDNSDOMAIN") & "</span><br>" & _
"Operating System: <span style=""color:green;"">" & Environ("OS") & "</span><br>" & _
"Excel Version: <span style=""color:green;"">" & Application.Version & "</span><br>" & _
"<br><span style=""font-size:10px""><br>" & _
"<br><br>---Automatically generated Error-Email---"
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
SQL_StatementError:
MsgBox "There seems to be a problem with the SQL Syntax in the programming."
Set OutApp = New Outlook.Application
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Subject = "Problems with the SQL Syntax in file '" & ThisWorkbook.Name & "'."
.HTMLBody = "<span style=""font-size:10px"">" & _
"---Automatically generated Error-Email---" & _
"</span><br><br>" & _
"Error report from the file '" & _
"<span style=""color:blue"">" & _
ActiveWorkbook.Name & _
"</span>" & _
"' located and saved on '" & _
"<span style=""color:blue"">" & _
ActiveWorkbook.Path & _
"</span>" & _
"'.<br>" & _
"It seems that there is a problem with the SQL-Code within trying to upload an extract to the server." & _
"SQL-Code causing the problems:" & _
"<br><br><span style=""color:green;"">" & _
strSQL & _
"</span><br><br><span style=""font-size:10px"">" & _
"---Automatically generated Error-Email---"
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
End Sub
注意，上面的代码清楚地区分（首先）连接到服务器然后（之后）向服务器发出查询以检索某些数据。两个步骤都是分开的，并且两种情况都有不同的错误处理程序。
此外，上面的示例代码也会导致返回空记录集。但代码能够使用另一个错误处理程序处理该事件。
如果连接失败或者发送到服务器的SQL语法包含错误，则上述代码将自动生成错误电子邮件（使用Outlook），其中包含一些详细信息，供您检查连接和SQL语法。
答案 1 :(得分：0)
您应该使用.EOF解决方案。这是我的一个例子，我经常使用它。
Sub AnySub()
''recordsets
Dim rec as ADODB.Recordset
''build your query here
sSql = "SELECT * FROM mytable where 1=0" ''just to have no results
''Fire query
Set rec = GetRecordset(sSql, mycnxnstring)
''and then loop throug your results, if there are any
While rec.EOF = False
''do something with rec()
rec.MoveNext
Wend
End sub
此处函数GetRecordset()由：
Function GetRecordset(strQuery As String, connstring As String) As Recordset
Dim DB As ADODB.Connection
Dim rs As ADODB.Recordset
Set DB = New ADODB.Connection
With DB
.CommandTimeout = 300
.ConnectionString = connstring
.Open
End With
Set GetRecordset = DB.Execute(strQuery)
End Function
希望这有帮助。