问题描述
我正在处理一个VBA宏,该宏连接到SQL Server上的数据库,并运行一些查询并将结果保存在CSV文件中...只要查询返回数据,但是我有几天查询不' t返回任何结果,只是一个空表。我根据检查日期做了一个临时解决方案,并根据宏运行该查询或否...我想在我的代码中使其他方式,所以我不需要手动更改日期...我尝试过这些解决方案:
If(objMyRecordset.EOF = False)或者(objMyRecordset.BOF = False)然后
另外这个
如果objMyRecordset.RecordCount<> 0然后
但是问题是我的Recordset是空的,因为查询不返回任何行,所以在 objMyRecordset.Open
中显示错误我想添加一行代码,例如:
'//伪代码
如果(查询不返回结果)然后
(只是标题将保存在我的文件)
Else
(做我的代码的其余部分)
结束如果
这是我的代码。有什么建议吗非常感谢。
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
设置objMyCmd =新建ADODB.Command
设置objMyRecordset =新建ADODB.Recordset
'打开连接
objMyConn.ConnectionString =Provider = SQLOLEDB;数据源= *****; User ID = *****; Password = *****;
objMyConn.Open
'Set and Excecute SQL Command
设置objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText =SELECT * FROM [vw_X86_LOAD_AFTER_CUTOFF_REPORT_GAMMA]
objMyCmd.CommandType = adCmdText
'打开Recordset
设置objMyRecordset.Source = objMyCmd
objMyRecordset.Open
Workbooks.Open文件名:=C:\Reports\load_after_cutoff_postGamma.csv
工作簿(load_after_cutoff_postGamma.csv)。表(load_after_cutoff_postGamma)。激活
ActiveSheet.Range (A2)。CopyFromRecordset objMyRecordset
对于i = 0 To objMyRecordset.fields.Count - 1
工作表(load_after_cutoff_postGamma)。单元格(1,i + 1)= objMyRecordset。字段(i).name
下一个i
工作簿(load_after_cutoff_postGamma.csv)。表(load_after_cutoff_postGamma)。Cells.EntireColumn.AutoFit
工作簿(load_after_cutoff_postGamma.csv) aveChanges:= True
MsgBox您的文件已保存为load_after_cutoff_postGamma.csv
如果连接到服务器时遇到问题,那么这是由于以下任何一种:
- 不正确的连接字符串
- 不正确的凭据
- 服务器不可达(例如:网线断开连接)
- 服务器未启动并运行
向导致空记录集的服务器发送查询是不一个 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
设置conServer =新建ADODB.Connection
conServer.ConnectionString =PROVIDER = SQLOLEDB;_
& DATA SOURCE =& strServer& ; _
& INITIAL CATALOG =& strDatabase& ; _
& User ID ='UserNameWrappedInSingleQuotes';_
& Password ='PasswordWrappedInSingleQuotes';
错误GoTo SQL_ConnectionError
conServer.Open
错误GoTo 0
strSQL =set nocount on;
strSQL = strSQL& select *
strSQL = strSQL& 从sys.tables as t
strSQL = strSQL& 其中t.name ='';
设置rstResult =新建ADODB.Recordset
rstResult.ActiveConnection = conServer
错误转到SQL_StatementError
rstResult.Open strSQL
错误GoTo 0
如果不是rstResult.EOF而不是rstResult.BOF然后
ThisWorkbook.Worksheets(1).Range(A1)。CopyFromRecordset rstResult
'While not rstResult.EOF And Not rstResult.BOF
''做某事
'rstResult.MoveNext
'Wend
Else
'https:// msdn。 microsoft.com/en-us/library/windows/desktop/ms675546(v=vs.85).aspx
选择案例conServer.State
'adStateClosed
案例0
MsgBox 与服务器的连接已关闭。
'adStateOpen
案例1
MsgBox连接已打开,但查询没有返回任何数据。
'adStateConnecting
案例2
MsgBox连接...
'adStateExecuting
案例4
MsgBox执行...
'adStateFetching
案例8
MsgBox获取...
案例Else
MsgBox conServer.State
结束选择
结束如果
设置rstResult =没有
退出子
SQL_ConnectionError:
MsgBox无法连接到服务器请确保您有一个工作连接到服务器。
设置OutApp =新的Outlook.Application
设置OutMail = OutApp.CreateItem(0)
带OutMail
.Subject =连接数据库的问题& strDatabase& 在服务器上托管& strServer& '
.HTMLBody =< span style =font-size:10px> ---自动生成的错误电子邮件---& _
< / span>< br>< br>来自文件& _
< span style =color:blue> &安培; ThisWorkbook.Name& _
< / span>',并保存在'< span style =color:blue> &安培; _
ThisWorkbook.Path& < /跨度>< BR>中&安培; _
Excel无法建立与服务器的连接。 &安培; <峰; br><峰; br> 中&安培; _
计算机名称:< span style =color:green;> &安培; Environ(COMPUTERNAME)& < /跨度><峰; br> 中&安培; _
登录为:< span style =color:green;> &安培; Environ(USERDOMAIN)& /& Environ(USERNAME)& < /跨度><峰; br> 中&安培; _
域服务器:< span style =color:green;> &安培; Environ(LOGONSERVER)& < /跨度><峰; br> 中&安培; _
用户DNS域:< span style =color:green;> &安培; Environ(USERDNSDOMAIN)& < /跨度><峰; br> 中&安培; _
操作系统:< span style =color:green;> &安培; Environ(OS)& < /跨度><峰; br> 中&安培; _
Excel版本:< span style =color:green;> &安培; Application.Version& < /跨度><峰; br> 中&安培; _
< br>< span style =font-size:10px>< br> &安培; _
< br>< br> ---自动生成的错误电子邮件---
.Display
结束与
设置OutMail =没有
Set OutApp = Nothing
退出Sub
SQL_StatementError:
MsgBox在编程中似乎有一个SQL语法的问题。
设置OutApp =新的Outlook.Application
设置OutMail = OutApp.CreateItem(0)
与OutMail
.Subject =文件中的SQL语法的问题 & ThisWorkbook.Name& 。
.HTMLBody =< span style =font-size:10px> &安培; _
---自动生成的错误电子邮件---& _
< / span>< br>< br> &安培; _
从文件& _
< span style =color:blue> &安培; _
ActiveWorkbook.Name& _
< / span> &安培; _
'位于并保存在& _
< span style =color:blue> &安培; _
ActiveWorkbook.Path& _
< / span> &安培; _
'。< br> &安培; _
似乎在尝试将提取文件上传到服务器时SQL代码有问题。 &安培; _
引起问题的SQL代码:& _
< br>< br>< span style =color:green;> &安培; _
strSQL& _
< / span>< br>< br>< span style =font-size:10px> &安培; _
---自动生成的错误电子邮件---
.Display
结束
设置OutMail =没有
设置OutApp =没有
退出Sub
End Sub
请注意,以上代码清楚地区分(第一)连接到服务器,然后(之后)向服务器发出查询以检索一些数据。两个步骤都是分开的,并且对于这两种情况都有不同的错误处理程序。
此外,上述示例代码还导致返回一个空的记录集。但是代码可以用另一个错误处理程序来处理该事件。
如果连接失败或者发送到服务器的SQL语法包含错误,上述代码将自动生成错误电子邮件(使用Outlook),其中包含一些详细信息以检查连接和SQL语法。
I am working on a VBA macro which connects to my database on SQL Server and run some queries and save the results on CSV files... it works fine just when the queries returns data but i have days where the query doesn't return any results, just an empty table. I made a temporary solution based on checking the date and according it the macro runs that query or no... I want to make it other way now in my code so that i don't need to change the date everytime manually...
I tried these solutions :
If (objMyRecordset.EOF = False) Or (objMyRecordset.BOF = False) Then
Also this
If objMyRecordset.RecordCount <> 0 Then
but the problem is my Recordset is empty because the query doesn't return any rows so it shows me error in objMyRecordset.Open
I want to add a line of code like this for example :
'// 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
Here is my code. Any suggestions please ? Thank you very much.
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"
If you experience problems connecting to your server then this is due to any of the following:
- an incorrect connection string
- incorrect credentials
- the server is not reachable (for example: network cable disconnected)
- the server is not up and running
Sending a query to a server which results in an empty recordset is not a reason for an ADODB.Connection
to fail.
Here is a little bit of code for you to try and debug the connection in a first step and then the query in a second step:
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
Note, that the above code clearly distinguishes between (first) connecting to the server and then (afterwards) issuing a query to the server to retrieve some data. Both steps are separated and there is a different error handler for either case.
Furthermore, the above sample code also results in an empty recordset being returned. But the code is able to handle that incident with yet another error handler.
If the connection fails or if the SQL syntax being sent to the server contains error(s) then the above code will automatically generate an error email (using Outlook) with some details for you to check the connection and the SQL syntax.
这篇关于VBA宏在csv文件中保存SQL查询的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!