VBA宏将SQL查询保存在csv文件中_Vba_Excel

VBA宏将SQL查询保存在csv文件中

vba excel

VBA宏将SQL查询保存在csv文件中,vba,excel,Vba,Excel,我正在处理一个VBA宏，它连接到SQL Server上的数据库，运行一些查询并将结果保存在CSV文件上。。。仅当查询返回数据时，它就可以正常工作，但有时查询不返回任何结果，只返回一个空表。我在检查日期的基础上做了一个临时解决方案，并根据它运行宏，查询或否。。。我现在想在我的代码中使用其他方式，这样我就不需要每次手动更改日期我尝试了以下解决方案： If (objMyRecordset.EOF = False) Or (objMyRecordset.BOF = False) Then 还有这个

我正在处理一个VBA宏，它连接到SQL Server上的数据库，运行一些查询并将结果保存在CSV文件上。。。仅当查询返回数据时，它就可以正常工作，但有时查询不返回任何结果，只返回一个空表。我在检查日期的基础上做了一个临时解决方案，并根据它运行宏，查询或否。。。我现在想在我的代码中使用其他方式，这样我就不需要每次手动更改日期

我尝试了以下解决方案：

If (objMyRecordset.EOF = False) Or (objMyRecordset.BOF = False) Then

还有这个

If objMyRecordset.RecordCount <> 0 Then

这是我的密码。有什么建议吗？多谢各位

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"

您应该使用

.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

希望这能有所帮助。

如果您在连接服务器时遇到问题，则这是由于以下原因造成的：

不正确的连接字符串

不正确的凭证

无法访问服务器（例如：网线断开）

服务器未启动并正在运行

向服务器发送一个导致空记录集的查询不是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

选项显式
公共事务小组
作为字符串的Dim strSQL
将strServer设置为字符串
将strDatabase设置为字符串
将OutMail设置为Outlook.MailItem
将rstResult设置为ADODB.Recordset
作为ADODB连接的调光储油柜
将OutApp设置为Outlook.Application
strServer=“”
strDatabase=“master”
Set conServer=新的ADODB.连接
conservater.ConnectionString=“PROVIDER=SQLOLEDB；”_
&“数据源=”&strServer&“；”_
&“初始目录=”&strDatabase&“；”_
&“用户ID='UserNameWrappedInSingleQuotes'_
&“Password='PasswordWrappedInSingleQuotes'
转到SQL\u ConnectionError时出错
储油柜，打开
错误转到0
strSQL=“将nocount设置为on；”
strSQL=strSQL&“选择*”
strSQL=strSQL&“从sys.tables作为t”
strSQL=strSQL&“其中t.name=”
Set rstResult=New ADODB.Recordset
rstResult.ActiveConnection=保存器
On错误转到SQL_语句错误
rstResult.openstrsql
错误转到0
如果不是rstResult.EOF，也不是rstResult.BOF，则
此工作簿。工作表（1）。范围（“A1”）。复制自记录集rstResult
'而不是rstResult.EOF和rstResult.BOF
“做点什么
'rstResult.MoveNext
“温德
其他的
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms675546（v=vs.85）.aspx
选择Case-conServer.State
”他说
案例0
MsgBox“与服务器的连接已关闭。”
“开着
案例1
MsgBox“连接已打开，但查询未返回任何数据。”
“是的
案例2
MsgBox“正在连接…”
"adstate",
案例4
MsgBox“正在执行…”
“吸引人
案例8
MsgBox“正在获取…”
其他情况
州政府
结束选择
如果结束
设置rstResult=Nothing
出口接头
SQL\u连接错误：
MsgBox“无法连接到服务器。请确保与服务器的连接正常。”
Set-OutApp=新建Outlook.Application
Set-OutMail=OutApp.CreateItem（0）
发邮件
.Subject=“连接到数据库时出现问题”“&strDatabase&”“托管在服务器上”“&strServer&”“”
.HTMLBody=“---自动生成的错误电子邮件----”&_
“

文件中的错误报告”_
“”&ThisWorkbook.Name&_
“‘在上找到并保存’&”_
ThisWorkbook.Path&“.”
“&”_
“Excel无法建立与服务器的连接。要遵循技术数据。”&“

”&”_
“计算机名：”&Environ（“计算机名”）和“
”&_
以“&Environ（“USERDOMAIN”）&”/“&Environ（“USERNAME”）和“
”的身份登录_
“域服务器：”&Environ（“LOGONSERVER”）和“
”和_
“用户DNS域：”&环境（“用户DNS域”）&“
”和_
“操作系统：”&Environ（“OS”）和“
”&_
“Excel版本：”&Application.Version&“
”&_
“

”和_
“

自动生成错误电子邮件--”
.展示
以
发送邮件=无
设置应用程序=无
出口接头
SQL_语句错误：
MsgBox“编程中的SQL语法似乎有问题。”
Set-OutApp=新建Outlook.Application
Set-OutMail=OutApp.CreateItem（0）
发邮件
.Subject=“文件“&&thishworkbook.Name&”中的SQL语法有问题。”
.HTMLBody=”“&_
“---自动生成的错误电子邮件----”&_
“

”和_
“文件“”中的错误报告（&R）”_
"" & _
ActiveWorkbook.Name&_
"" & _
“‘在上找到并保存’&”_
"" & _
ActiveWorkbook.Path&_
"" & _
“.
”和_
“试图将摘录上载到服务器时，SQL代码似乎有问题。”_
“导致问题的SQL代码：&”_
“

”和_
strSQL&_
“

”和_
“---自动生成的错误电子邮件---”
.展示
以
发送邮件=无
设置应用程序=无
出口接头
端接头

请注意，上面的代码清楚地区分了（首先）连接到服务器，然后（之后）向服务器发出查询以检索某些数据。这两个步骤是分开的，两种情况都有不同的错误处理程序

此外，上述示例代码还导致返回一个空记录集。但代码能够用另一个错误处理程序处理该事件

如果

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