Use excel Macro export data from database

时间：2022-11-22 13:57:37
Sub DownLoadMacro()  '定义过程名称

Dim i As Integer, j As Integer, sht As Worksheet 'i,j为整数变量；sht 为excel工作表对象变量，指向某一工作表

Dim cn As New ADODB.Connection '定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用

Dim rs As New ADODB.Recordset  '定义记录集对象，保存数据表

Dim strCn As String, strSQL As String '字符串变量

Dim wshnetwork, info As String

Set wshnetwork = CreateObject("WScript.Network")

info = wshnetwork.UserName

strCn = "Provider=sqloledb;Server=IP;Database=DATABASENAME;Uid=SA;Pwd=******;"

'定义数据库链接字符串

'下面的语句将读取数据表数据，并将它保存到excel工作表中

strSQL = "SELECT dbo.V_Export.SKU,dbo.V_Export.Model,dbo.V_Export.CCC,dbo.V_Export.CertExpiryDate,dbo.V_Export.Permission,dbo.V_Export.CNW1,dbo.V_Export.CNW2, CASE When dbo.V_Export.PhaseOut ='O2' THEN 'Y' ELSE '' END AS PhaseOut,dbo.V_Export.SatetyStock,dbo.V_Export.Leadtime,dbo.V_Export.[DESC] FROM  dbo.V_Export ORDER BY dbo.V_Export.SKU ASC, dbo.V_Export.SatetyStock DESC, dbo.V_Export.Leadtime DESC "    '定义SQL查询命令字符串

cn.Open strCn   '与数据库建立连接，如果成功，返回连接对象cn

If cn = "" Then

    MsgBox ("Connect Faild") '提示连接数据库失败

Else

    rs.Open strSQL, cn  '执行strSQL所含的SQL命令，结果保存在rs记录集对象中

    i =

    Set sht = ThisWorkbook.Worksheets("CacuFromServer")   '把sht指向当前工作簿的CacuFromServer工作表

    sht.Range("A2:I65536").ClearContents

    Do While Not rs.EOF     '当数据指针未移到记录集末尾时，循环下列操作

        sht.Cells(i, ) = rs("SKU")    '把当前记录的字段1的值保存到CacuFromServer工作表的第i行第1列

        sht.Cells(i, ) = rs("DESC")

        sht.Cells(i, ) = rs("Model")    '把当前字段2的值保存到CacuFromServer工作表的第i行第3列

        sht.Cells(i, ) = rs("CCC")    '把当前记录的字段3的值保存到CacuFromServer工作表的第i行第4列

        sht.Cells(i, ) = rs("CertExpiryDate")    '把当前记录的字段4的值保存到CacuFromServer工作表的第i行第5列

        sht.Cells(i, ) = rs("Permission")    '把当前字段5的值保存到CacuFromServer工作表的第i行第6列

        sht.Cells(i, ) = rs("SatetyStock")    '把当前字段7的值保存到CacuFromServer工作表的第i行第7列

        sht.Cells(i, ) = rs("Leadtime")    '把当前字段8的值保存到CacuFromServer工作表的第i行第8列

        sht.Cells(i, ) = rs("PhaseOut")    '把当前字段9的值保存到CacuFromServer工作表的第i行第9列          '

        sht.Cells(i, ) = rs("CNW1")    '把当前记录的字段10的值保存到CacuFromServer工作表的第i行第10列

        sht.Cells(i, ) = rs("CNW2")

        sht.Cells(i, ) = rs("SKU")

        rs.MoveNext                      '把指针移向下一条记录

        i = i +                         'i加1，准备把下一记录相关字段的值保存到工作表的下一行

    Loop '循环

    rs.Close   '关闭记录集，至此，程序将把某数据表的字段1到字段6保存在excel工作表CacuFromServer的第1到6列，行数等于数据表的记录数

    strSQL = "insert into dbo.DIM_LogInfo  values('" & info & "',getdate())"

    cn.Execute strSQL  '执行strSQL所含的SQL命令

    strSQL = "select max(exportDate) as ExportFinalDate from dbo.DIM_LogInfo"

    rs.Open strSQL

    Set sht = ThisWorkbook.Worksheets("Search")   '把sht指向当前工作簿的CacuFromServer工作表

    sht.Cells(, ) = rs("ExportFinalDate")

    rs.Close

    cn.Close  '关闭数据库链接,释放资源

    MsgBox ("Download Succeed") '提示导出成功

End If

End Sub

相关文章