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 = 2 Set sht = ThisWorkbook.Worksheets("CacuFromServer") '把sht指向当前工作簿的CacuFromServer工作表 sht.Range("A2:I65536").ClearContents Do While Not rs.EOF '当数据指针未移到记录集末尾时,循环下列操作 sht.Cells(i, 1) = rs("SKU") '把当前记录的字段1的值保存到CacuFromServer工作表的第i行第1列 sht.Cells(i, 2) = rs("DESC") sht.Cells(i, 3) = rs("Model") '把当前字段2的值保存到CacuFromServer工作表的第i行第3列 sht.Cells(i, 4) = rs("CCC") '把当前记录的字段3的值保存到CacuFromServer工作表的第i行第4列 sht.Cells(i, 5) = rs("CertExpiryDate") '把当前记录的字段4的值保存到CacuFromServer工作表的第i行第5列 sht.Cells(i, 6) = rs("Permission") '把当前字段5的值保存到CacuFromServer工作表的第i行第6列 sht.Cells(i, 7) = rs("SatetyStock") '把当前字段7的值保存到CacuFromServer工作表的第i行第7列 sht.Cells(i, 8) = rs("Leadtime") '把当前字段8的值保存到CacuFromServer工作表的第i行第8列 sht.Cells(i, 9) = rs("PhaseOut") '把当前字段9的值保存到CacuFromServer工作表的第i行第9列 ' sht.Cells(i, 10) = rs("CNW1") '把当前记录的字段10的值保存到CacuFromServer工作表的第i行第10列 sht.Cells(i, 11) = rs("CNW2") sht.Cells(i, 12) = rs("SKU") rs.MoveNext '把指针移向下一条记录 i = i + 1 '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(1, 6) = rs("ExportFinalDate") rs.Close cn.Close '关闭数据库链接,释放资源 MsgBox ("Download Succeed") '提示导出成功 End If End Sub