SQL SERVER自动发邮件

一、测试实验过程

1.邮件服务器配置:

  服务器名称：若在公司使用，即公司的邮件服务器名称,无须服务器IP地址,域名即可，与outlook设置相同,端口号25

  pop3是收邮件的协议,端口号25

  smtp是发邮件的协议,端口号110

  如何配置参考：http://blog.csdn.net/ghj1976/article/details/3936286

2.定时任务设置:

  使用SQL Server Agent 设置作业定时任务（貌似Express也没有这个功能）

  如何设置作业参考http://www.soaspx.com/dotnet/sql/mssql/sql2005/sqlservr2005_20120308_8721.html

  游标,http://www.2cto.com/database/201110/108104.html

3.第一次直接定时任务报错了

  原因：未指定数据库 

  第二次查询作测试,语句如下:

  EXEC msdb.dbo.sp_send_dbmail

    @profile_name = 'testmail',

    @recipients = '[e-mail]',

    @subject = 'Automated Success Message',

    -----------一定要先指定数据库,否则Query无法找到数据-----------

    @execute_query_database='DAS',

    @query='select ItermID As ''物资编号'',Lowestquantity As ''最低库存'',Quantity As ''现有库存'' from T_AlarmInventory',

    @attach_query_result_as_file = 1

    -------------不写此参数默认txt文件,修改为xls就是excel,写为csv就是csv文件,但是xls出现的excel文件格式与要求不符,所有列数据挤在1列显示,本质还是txt文件

    @query_attachment_filename = 'a.xls'

 需要后续测试的环节,这个版本语句的附件是txt文件,怎么调整为xls文件?????（目前无办法）

4.Bcp的使用

思路：bcp定时输出文档到具体路径下，定时执行系统存储过程msdb.dbo.sp_send_dbmail发邮件

http://wandejun1012.iteye.com/blog/1568447

a. 将SQL SERVER中查询到的数据导成一个Excel文件

T-SQL代码：

EXEC master..xp_cmdshell 'bcp 库名.dbo.表名out c:/Temp.xls -c -q -S"servername" -U"sa" -P""'

参数：S 是SQL服务器名；U是用户；P是密码

EXEC master..xp_cmdshell 'bcp axzq.dbo.Staff out dtaff.xls -c -q -S"." -U"sa" -P"gazx"'

说明：还可以导出文本文件等多种格式

实例:EXEC master..xp_cmdshell 'bcp saletesttmp.dbo.CusAccount out c:/testOrder.xls -c -q -S"pmserver" -U"sa" -P"sa"'

EXEC master..xp_cmdshell 'bcp "SELECT au_fname, au_lname FROM pubs..authors ORDER BY au_lname" queryout C:/ authors.xls -c -Sservername -Usa -Ppassword'

EXEC master..xp_cmdshell 'bcp "select name from axzq..staff order by name"  queryout dtaffName.xls -c -q -S"." -U"sa" -P"gazx"'

b. 执行sp_send_dbmail

EXEC sp_send_dbmail @profile_name='congName', 

@recipients='[e-mail];[e-mail]', 

@subject='Test message', 

@body='This is the body of the test message. 

Congrates Database Mail Received By you Successfully.', 

@file_attachments='c:\testOrder.xlsx' 

 

SELECT sent_status FROM sysmail_mailitems 

GO 

SELECT * FROM sysmail_log 

GO 

5. Bcp使用备注

  需要打开外围应用服务器配置xpcmdshell,外围应用服务器配置2005与2008有变化,2008现在的设置在服务器的节点下右击"方面"下设置

  bcp在2008里,导出xls文件可以打开,xlsx无法打开,xls虽能打开,但是只有数据,没有字段名

6. SQL Server分类导出数据，

  可参考http://wenku.baidu.com/view/3980e96c25c52cc58ad6be06.html

二、解决方案

1.       方法：Excel+VBA+Outlook+SQL Server/Access+定时任务

2.       有关VBA，ADO链接数据源

参考xiaohou新浪博客

3.       定时执行Excel文件

路径：控制面板\所有控制面板项\管理工具\任务计划程序

注意：需要设置Excel分发邮件为打开自动执行；

若是Excel分发邮件半夜执行，需要设置任务计划程序为“定时开机-定时执行Excel-定时关机”

4. VBA代码

Sub sendmailfor()
   Dim sql As String
   Dim tomailId As String
    Set Sheet = ThisWorkbook.Worksheets("Sheet2")
   For i = 11 To 12:
       sql = Sheet.Range("B" & i).Value
       tomailId = Sheet.Range("E" & i).Value
       Filename = Sheet.Range("C" & i).Value & " (" & Sheet.Range("D" & i).Value & ") " _
                  & Format(Now, "yyyy-dd-mmm h-mm-ss")
      Call GetDatafromSQLSERVER(sql, tomailId, Filename)
  Next i
 'MsgBox "发送完毕!"
End Sub

Public Sub GetDatafromSQLSERVER(sql, tomailId, Filename)
'声明变量
    Dim cnn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim ws As Worksheet
    Dim mydata As String, mytable As String
    Dim i As Long, j As Long
 '赋值
    Set ws = ThisWorkbook.Worksheets("data")  '取到名为data的sheet
  
    'ws.Cells.Clear
    mydata = "DAS"    ''数据库名
    cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
        & "Data Source=\\IP地址\***\*****\*****\*****.mdb;" _
        & "Jet OLEDB:Database Password=" & "111111"     '数据库连接若加密需要此语句
    cnn.Open   '''打开数据库
   
    Set rs = cnn.Execute(sql)   '''执行sql语句
    For i = 0 To rs.Fields.Count - 1   '''取到字段数   写入title到第一行
        ws.Cells(1, i + 1) = rs.Fields(i).Name  '取字段名
        ws.Cells(1, i + 1).Font.Bold = True     '字段名加粗
    Next i
   
    ws.Range("A2").CopyFromRecordset rs         'A2单元格粘贴rs数据
    ws.Columns.AutoFit                          '设置合适列宽
    rs.Close  '关闭结果集
    cnn.Close   '关闭数据库连接
   
    Call Mail_ActiveSheet(ws, tomailId, Filename)  ''''发送邮件
    ws.Cells.Clear
    'ws.Delete
    Set rs = Nothing
    Set cnn = Nothing
    Set ws = Nothing
End Sub

Sub Mail_ActiveSheet(ws, mailTo, Filename)
'Working in 2000-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Sheet As Worksheet
   

    With Application
        .ScreenUpdating = False        '运行时屏幕是否闪屏
        .EnableEvents = False          'EnableEvents 属性来启用或禁用事件
    End With

    Set Sourcewb = ActiveWorkbook   '取得当前活动的excel窗口
    ws.Copy   '将ws  sheet中的数据拷贝过来
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
  
   
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & ""
    Set Sheet = Sourcewb.Worksheets("Sheet2")   '''当前button所在的sheet
   ' TempFileName = Sheet.Range("J28").Value & " (" & Sheet.Range("K28").Value & ") " _
                  & Format(Now, "yyyy-dd-mmm h-mm-ss")   '''生成文件名，以J28和L28中的数据位文件名开始的，文件名以当前时间结尾
    TempFileName = Filename
    Set OutApp = CreateObject("Outlook.Application")  '打开outlook
    Set OutMail = OutApp.CreateItem(0)  '生成mail

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum    ''''将生成的数据保存到新的excel文件中
        On Error Resume Next
        With OutMail
            .To = mailTo ' "[e-mail]"   '发给谁
            .CC = ""   '''抄送
            .BCC = ""  '暗地抄送
            .Subject = Sheet.Range("C7").Value  '邮件标题
            .Body = Sheet.Range("C8").Value '邮件内容
            .Attachments.Add Destwb.FullName   '添加附件
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display  '发送
        End With
        On Error GoTo 0
        .Close SaveChanges:=False    '关闭生成文件，但不保存
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
End Sub