VBA查询Access数据库导出的数据不完整问题求指点

wx117

我从ACCESS数据库文件中使用SQL查询导出的表格信息不完整，主要有两个问题：
1、比如数据库中有1000行数据，但是查询导出的数据只有800多行，有差异
2、SQL语句中我限定了从数据库中查询的End_Date列的日期只能大于等于查询当天的时间，但是查询出来的结果还是会有很多是小于这个日期的。
以上两个问题需要请论坛中的高手指点，不知道问题出在哪里，非常感谢！


代码如下：（在宏文件中是鼠标邮件运行这个代码）
Public Sub Export1()
Dim DBS As Database
Dim rsttemp1 As Recordset
Dim rsttemp As Recordset
Dim rsttemp2 As Recordset
Dim RSTTEMP9 As Recordset
Dim rst As Recordset
Dim qdf As QueryDef
Dim StrSQL, STRSQL1 As String
Dim Date1 As Date
Dim Date2 As Date
Dim datestr As Variant
Date1 = DTPicker1
Date2 = DTPicker2
Dim st As Variant
st = UserForm13.ComboBox1.Value
Dim re As Variant
Dim Pr As Variant
Dim Ci As Variant
Dim di As Variant
Dim dep As Variant
Dim id As Variant
Dim Sn As Variant
Dim pt As Variant
Dim tb As Variant
Dim k1 As Variant
Dim tp As Variant
Dim i As Variant
Dim List1
Dim filepath As String
Dim datafilename As String
'USERID = Get_User_Name
'filepath = "C:\Users\" & USERID & "\Desktop\"
filepath = "C:\YPTemplate\"
  
'datafilename = "信息清单" & Format(Date, "yyyy-m-d ") & Format(Time, "hh.mm.ss")
datafilename = "当前正在生效清单"

datestr = VBA.Date
re = UserForm13.Label11.Caption
Pr = UserForm13.Label12.Caption
Ci = UserForm13.Label13.Caption
Sn = UserForm13.Label21.Caption
st = UserForm13.ComboBox1.Value

Connect_Original_Database
Set DBS = OpenDatabase(myfile)
If UserForm13.ComboBox1.Value = "" Then
   MsgBox "请输店号!", , "系统提示"
Exit Sub
End If
If UserForm13.ComboBox1.Value <> "" Then
   StrSQL = "SELECT ID as 序号,Source_ID,Tab as 目录,PD_Name as 品名,Sheet as 类型,Type as 类别,规格_L1 as 规格, Div as 区划, Dept as 部门, YP_Promotion_Type as 形式,PR_Description as 简述,Start_Date as 开始,End_Date as 结束,(除XX) as 除外 FROM PRD_Data where  (Send like '*全国*' OR Send like '*" & re & "*' OR Send like '*" & Pr & "*' OR Send like '*" & Ci & "*' OR Send like '*" & st & "*') and (isnull(Omit) or not (Omit like '*" & re & "*' or Omit like '*" & Pr & "*' or Omit like '*" & Ci & "*' or Omit like '*" & st & "*')) and (End_Date>= " & datestr & ")"
End If
Set qdf = DBS.CreateQueryDef("", StrSQL)
Set rsttemp1 = qdf.OpenRecordset
If rsttemp1.RecordCount = 0 Then
    MsgBox "无此记录!", , "系统提示"
Else
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
  Sheets(1).Select

ActiveSheet.UsedRange.Offset(1).Delete
   
For i = 1 To rsttemp1.Fields.Count

Cells(1, i) = rsttemp1.Fields(i - 1).Name
Next
[a2].CopyFromRecordset rsttemp1
End If
    Cells.Select
    Cells.EntireColumn.AutoFit
   
    Range("A1:N1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
   
    Cells.Select
    With Selection.Font
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
    End With
   
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
    Cells.Select
    Selection.ColumnWidth = 8.88
        
        
  ActiveWorkbook.SaveAs (filepath & datafilename & ".xlsx")
  Workbooks(datafilename & ".xlsx").Close
   
  MsgBox "正在生效记录已下载至文件夹!", , "系统提示"
  
DBS.Close
Set rsttemp1 = Nothing
Set DBS = Nothing
On Error GoTo 0

End Sub