Private Sub CommandButton1_Click()
Dim cn As ADODB.Connection
Dim res As ADODB.Recordset
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim STRSQL As String
Dim I As Integer
Dim ROW As Integer
STRSQL = "select * from report1 where 日期=#" & DTPicker1.Value & "#"
'数据库表名称
If Dir("c:\khreport1.xlsx") = "" Then  '判断文件是否存在,不存在则退出
'报表模板位置
  MsgBox "报表模版文件不存在"
  Exit Sub
End If
Set cn = New ADODB.Connection
cn.ConnectionString = " DSN=KHreport1;UID=;PWD=;"  '数据源名称
cn.Open
Set res = New ADODB.Recordset
res.Open STRSQL, cn, adOpenKeyset, adLockOptimistic
If res.RecordCount <= 0 Then
MsgBox "你要查询的数据不存在,可能已被删除", vbInformation + vbOKOnly, "系统提示"
   res.Close
   Set res = Nothing
   cn.Close
   Set cn = Nothing
   Exit Sub
Else
    res.MoveFirst
    Set xlApp = New Excel.Application
   xlApp.DisplayAlerts = ture
   xlApp.Visible = ture
Set xlBook = xlApp.Workbooks.Open(StrDir & "c:\khreport1.xlsx")
'报表模板位置
    Set xlSheet = xlBook.Worksheets(1)
    xlBook.Application.Visible = True
    xlSheet.Cells(2, "n") = CDate(res.Fields(0))
    I = 1
    While I < res.RecordCount
         ROW = I + 4
           xlSheet.Cells(ROW, "a") = res.Fields(0)
         xlSheet.Cells(ROW, "b") = res.Fields(1)
         xlSheet.Cells(ROW, "c") = res.Fields(2)
         xlSheet.Cells(ROW, "d") = res.Fields(3)
         xlSheet.Cells(ROW, "e") = res.Fields(4)
          xlSheet.Cells(ROW, "f") = res.Fields(5)
         xlSheet.Cells(ROW, "g") = res.Fields(6)
         xlSheet.Cells(ROW, "h") = res.Fields(7)
         xlSheet.Cells(ROW, "i") = res.Fields(8)
         xlSheet.Cells(ROW, "j") = res.Fields(9)
          xlSheet.Cells(ROW, "k") = res.Fields(10)
         xlSheet.Cells(ROW, "l") = res.Fields(11)
         xlSheet.Cells(ROW, "m") = res.Fields(12)
         xlSheet.Cells(ROW, "n") = res.Fields(13)
         xlSheet.Cells(ROW, "o") = res.Fields(14)
         xlSheet.Cells(ROW, "p") = res.Fields(15)
         I = I + 1
         res.MoveNext
    Wend
    xlApp.Visible = True
   xlApp.DisplayAlerts = False
   Set xlSheet = Nothing
   Set xlBook = Nothing
   Set xlApp = Nothing
  End If
ERR:End Sub

解决方案 »

  1.   

    大概看了一下,我感觉是这句的问题: STRSQL = "select * from …………1. 首先,把你的那两个 # 换成单引号试试;
    2. 其次,看看DTPicker1.Value中的年月日是什么分隔符,如果是/就把它替换成-试试。
     我几乎没使用过DTPicker控件,不清楚它的特点,现在也不方便试验。
     如果不能通过属性设置分隔符,可以用Format函数或Replace函数来处理。
      

  2.   

    STRSQL = "select * from report1 where 日期=#" & Format(DTPicker1.Value, "yyyy-mm-dd" & "#"从 DTPicker 中返回的数据格式取决于当前主机操作系统中的地区语言设置,必须用 Format 函数来确定格式。
      

  3.   

    STRSQL = "select * from report1 where 日期=#" & Format(DTPicker1.Value, "yyyy-mm-dd") & "#"