[问题求助] vbs访问Access数据库查询语句中where报错是什么原因

waiter_bat

Dim objConnection                          'CONNECTION对象实例 
Dim objRecordSet                                   'RECORDSET对象实例        
Dim objCommand                                '命令对象实例 
Dim strConnectionString                        '连接字符串
Dim Tsql                                       'sql操作
Dim MyArray()                                  '数组（存储表有多少列名）
 
' ******************************************************************** 
' 函数说明：连接数据库; 
' 参数说明：(1)strDBType（数据库类型：如ORACEL；DB2；SQL；ACCESS） 
'           (2)strDBAlias（数据库别名） 
'           (3)strUID（用户名） 
'           (4)strPWD（密码） 
'           (5)strIP（数据库IP地址：仅SQL SERVER 使用） 
'           (6)strLocalHostName（本地主机名：仅SQL SERVER 使用） 
'           (7)strDataSource（数据源：仅ACCESS使用；如d:\yysc.mdb） 
' 返回结果：无 
' 调用方法: ConnectDatabase(strDBType, strDBAlias, strUID, strPWD, strIP, strLocalHostName, strDataSource) 
' ******************************************************************** 
Sub ConnectDatabase(strDBType, strDBAlias, strUID, strPWD, strIP, strLocalHostName, strDataSource) 
    Set objConnection = CreateObject("ADODB.CONNECTION")                '1 - 建立CONNECTION对象的实例 
     
    Select Case UCase(Trim(strDBType)) 
        Case "ORACLE" 
            strConnectionString = "Driver={Microsoft ODBC for Oracle};Server=" & strDBAlias & ";Uid="_ 
                & strUID & ";Pwd=" & strPWD & ";"                                '2 - 建立连接字符串 
            objConnection.Open strConnectionString                                '3 - 用Open 方法建立与数据库连接 
        Case "DB2" 
            strConnectionString = "Driver={IBM DB2 ODBC DRIVER};DBALIAS=" & strDBAlias & ";Uid="_ 
                & strUID & ";Pwd=" & strPWD & ";"                                
            objConnection.Open strConnectionString                                
        Case "SQL" 
             strConnectionString = "DRIVER=SQL Server; SERVER=" & strIP & "; UID=" & strUID & "; PWD="_ 
                 & strPWD & "; APP=Microsoft Office 2003;WSID=" & strLocalHostName & "; DATABASE=" & strDBAlias & ";" 
            objConnection.Open strConnectionString                                            
        Case "ACCESS" 
            strConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & strDataSource &_
               ";Jet OLEDB:Database Password=" & strPWD & ";"	'win7X64位 access驱动用
            'strConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" & strDataSource &_ 
            '    ";Jet OLEDBatabase Password=" & strPWD & ";" 	’'winXP access驱动用
            objConnection.Open strConnectionString                                                  
        Case Else 
            MsgBox "输入的数据库类型格式有误" & vbCrLf & "支持的数据库类型格式：ORACLE；DB2；SQL；ACCESS；EXCEL" 
    End Select 
     
    If (objConnection.State = 0) Then 
        MsgBox "连接数据库失败！" 
    End If 
     
End Sub 
 
 
' ******************************************************************** 
' 函数说明：查询数据库（查询单列）; 
' 参数说明：  (1)strSql：SQL语句 
'           (2)strFieldName：字段名 
'           (3)str_Array_QueryResult：数组名（用来返回单列查询结果） 
' 返回结果：  intArrayLength：查询数据库返回的记录行数 
'           str_Array_QueryResult：数组名（用来返回单列查询结果） 
' 调用方法: intArrayLength = QueryDatabase(strSql, strFieldName, str_Array_QueryResult) 
' ******************************************************************** 
Function QueryDatabase(strSql, strFieldName, str_Array_QueryResult)
    Dim intArrayLength                                                                                     '数组长度 
     Dim i 
    i = 0   
    str_Array_QueryResult = Array()                                '重新初始化数组为一个空数组 
     
    Set objRecordSet = CreateObject("ADODB.RECORDSET")                '4 - 建立RECORDSET对象实例 
    Set objCommand = CreateObject("ADODB.COMMAND")              '5 - 建立COMMAND对象实例 
    objCommand.ActiveConnection = objConnection 
    objCommand.CommandText = strSql 
        objRecordSet.CursorLocation = 3 
        objRecordSet.Open objCommand                            '6 - 执行SQL语句,将结果保存在RECORDSET对象实例中 
     
    intArrayLength = objRecordSet.RecordCount                  '将查询结果的行数作为数组的长度
     
    If intArrayLength > 0 Then 
            ReDim str_Array_QueryResult(intArrayLength-1) 
             
            Do While NOT objRecordSet.EOF                                                '将数据库查询的列值赋值给数组             
                str_Array_QueryResult(i) = objRecordSet(strFieldName)
                MsgBox str_Array_QueryResult(i)
                objRecordSet.MoveNext 
                i = i + 1 
            Loop 
    Else 
            'ReDim str_Array_QueryResult(0)       
            'str_Array_QueryResult(0) = ""     
    End If
 
    QueryDatabase = intArrayLength
End Function 
 
 
 
' ******************************************************************** 
' 函数说明：返回符合查询结果的列的长度 
' 参数说明：(1)strSql：SQL语句 
' 返回结果：返回符合查询结果的列的长度 
' 调用方法: MaxLength = GetLenOfField(strSql) 
' ******************************************************************** 
Function GetLenOfField(strSql) 
    '如果SQL语句为空，则默认返回的列长度为0，结束函数;否则返回列的实际长度 
    If strSql = "" Then 
        GetLenOfField  = 0 
                Exit Function 
    Else 
            Set objRecordSet = CreateObject("ADODB.RECORDSET")                        '4 - 建立RECORDSET对象实例 
            Set objCommand = CreateObject("ADODB.COMMAND")              '5 - 建立COMMAND对象实例 
            objCommand.ActiveConnection = objConnection 
            objCommand.CommandText = strSql 
                objRecordSet.CursorLocation = 3 
                objRecordSet.Open objCommand                                '6 - 执行SQL语句,将结果保存在RECORDSET对象实例中 
             
            GetLenOfField = objRecordSet.RecordCount                              '返回符合查询结果的列的长度 
         
                Set objCommand = Nothing        
                Set objRecordSet = Nothing 
        End If 
End Function
 
 
' ******************************************************************** 
' 函数说明：返回符合查询结果的行的长度 
' 参数说明：(1)strSql：SQL语句 
' 返回结果：无 
' 调用方法: count=GetLenght(strSql) 
' ******************************************************************** 
Function  GetLenght(strSql)
        Dim objCommand 
        Dim objField        
         
If strSql = "" Then 
        GetLenght  = 0 
                Exit Function 
    Else
 
        Set objCommand = CreateObject("ADODB.COMMAND") 
        Set objRecordSet = CreateObject("ADODB.RECORDSET") 
        objCommand.CommandText = strSql 
        objCommand.ActiveConnection = objConnection 
        Set objRecordSet = objCommand.Execute
 
        ii=0
        Do Until objRecordSet.EOF 
                    For Each objField In objRecordSet.Fields
                            ii=ii+1
                    Next 
                    objRecordSet.MoveNext 
                    Debug.WriteLine
        Loop
         
        GetLenght = ii
 
        Set objCommand = Nothing 
        Set objRecordSet = Nothing 
End If                 
End Function
 
 
' ******************************************************************** 
' 函数说明：返回符合查询结果的表的名称 
' 参数说明：(1)strSql：SQL语句 
' 返回结果：无 
' 调用方法: Array()=GetArray(strSql) 
' ******************************************************************** 
Sub  GetArray(strSql)
        Dim objCommand 
        Dim objField        
        GetdataArray = Array()
        hh = GetLenOfField(strSql) '列长
        ll = GetLenght(strSql)     '行长
 
        Set objCommand = CreateObject("ADODB.COMMAND") 
        Set objRecordSet = CreateObject("ADODB.RECORDSET") 
        objCommand.CommandText = strSql 
        objCommand.ActiveConnection = objConnection 
        Set objRecordSet = objCommand.Execute
 
        Set objExcel = CreateObject("Excel.Application") 
        Set objWorkBook = objExcel.Workbooks.Open("d:\\1.xls") 
        Set objWorkSheet = objWorkBook.Sheets(1) 
        objExcel.Visible = False
 
        k=1
        ReDim GetdataArray(ll)
        Do Until objRecordSet.EOF 
                    For Each objField In objRecordSet.Fields
                    If k Mod (ll/hh)<> 0 Then
                        GetdataArray(k-1)=objField.Name
                        k=k+1
                        Else
                            GetdataArray(k-1)=objField.Name
                            Exit Do
                    End If 
                    Next
                    objRecordSet.MoveNext 
        Loop
         
        For i=1 To ll/hh
           objWorkSheet.cells(1,i)=GetdataArray(i-1)
        Next 
 
        objExcel.Workbooks(1).Save
        objExcel.Workbooks(1).Close
        objExcel.Quit
        Set objExcel = Nothing
        Set objWorkBook = Nothing
        Set objWorkSheet = Nothing
 
        Set objCommand = Nothing 
        Set objRecordSet = Nothing              
End Sub  
 
 
 
' ******************************************************************** 
' 函数说明：更新数据库;包括INSERT、DELETE 和 UPDATE操作 
' 参数说明：(1)strSql：SQL语句 
' 返回结果：无 
' 调用方法: UpdateDatabase(strSql) 
' ******************************************************************** 
Sub UpdateDatabase(strSql)
        Dim objCommand 
        Dim objField        
        hh = GetLenOfField(strSql) '列长
        ll = GetLenght(strSql)     '行长
 
        Set objCommand = CreateObject("ADODB.COMMAND") 
        Set objRecordSet = CreateObject("ADODB.RECORDSET") 
        objCommand.CommandText = strSql 
        objCommand.ActiveConnection = objConnection 
        Set objRecordSet = objCommand.Execute
 
        Set objExcel = CreateObject("Excel.Application") 
        Set objWorkBook = objExcel.Workbooks.Open("d:\\1.xls") 
        Set objWorkSheet = objWorkBook.Sheets(1) 
        objExcel.Visible = True
         
        i=1
        ii=1
        Do While NOT objRecordSet.EOF                                                '将数据库查询的列值赋值给EXECL             
                For ii=1 To ll/hh
                objWorkSheet.cells(i+1,ii) = objRecordSet(ii-1)
                Next
                objRecordSet.MoveNext 
                i = i + 1 
            Loop
 
         
        objExcel.Workbooks(1).Save
        'objExcel.Workbooks(1).Close
        'objExcel.Quit
        Set objExcel = Nothing
        Set objWorkBook = Nothing
        Set objWorkSheet = Nothing
        Set objCommand = Nothing 
        Set objRecordSet = Nothing 
                 
End Sub
 
 
' ******************************************************************** 
' 函数说明：关闭数据库连接; 
' 参数说明：无 
' 返回结果：无 
' 调用方法: CloseDatabase() 
' ******************************************************************** 
Sub CloseDatabase() 
    objRecordSet.Close 
    objConnection.Close 
     
    Set objCommand = Nothing 
    Set objRecordSet = Nothing 
    Set objConnection = Nothing 
End Sub 
 

 Dim data1,data2
	data1= InputBox("请输入开始日期","提示","2016-06-01")
		If IsEmpty(data1) Then WScript.Quit
    'MsgBox data1  显示输入日期
	data2= InputBox("请输入结束日期","提示","2016-07-01")
	If IsEmpty(data2) Then WScript.Quit
    'MsgBox data2
    
    
    
 Tsql ="select rfkh ,xfje From  lssj where xfzl='消费' and xfsj between '" & data1 & "' and '"& data2 &"'"  'dtmTargetDate >= dtmStartDate AND dtmTargetDate <= dtmEndDate
'Tsql ="select a.姓名 , a.当前余额,b.xf  from (select rfkh,ryxm as 姓名 ,rfye as 当前余额 From  ryxx) a left join "_
	'	&"(select rfkh ,max(xfje) as xf  From  lssj where xfzl='消费' and xfsj between '" & data1 & "' and '"& data2 &"' group by rfkh) b on a.rfkh=b.rfkh "
'Tsql= Tsql&"(select rfkh ,sum(xfje) as 本月增款金额 From  lssj "&"  "
'Tsql= Tsql&"where xfzl='增款' and xffs='现金交费' and  xfsj between '" & data1 & "' and '" & data2 &"' group by rfkh) c on a.rfkh=c.rfkh join  "&"  "
'Tsql= Tsql&"(select rfkh ,sum(xfje) 总消费金额 From  lssj "&"  "
'Tsql= Tsql&"where xfzl='消费' group by rfkh) x on a.rfkh=x.rfkh join  "&"  "
'Tsql= Tsql&"(select rfkh ,sum(xfje) 总增款金额 From  lssj  "&"  "
'Tsql= Tsql&"where xfzl='增款' and xffs='现金交费' group by rfkh) z on a.rfkh=z.rfkh where a.姓名 <>'院'  order by a.姓名"
'Call ConnectDatabase("ORACLE","longtj","ltjn","ltjn","","","") '数据连接操作
Call ConnectDatabase("ACCESS","","","","","","D:\Program Files\小麦科技消费系统\database\xf.mdb") '数据连接操作
Call GetArray(Tsql)
Call UpdateDatabase(Tsql)
复制代码

vaste

Tsql ="select rfkh ,xfje From  lssj where xfzl='消费' and xfsj between '" & data1 & "' and '"& data2 &"'"  'dtmTargetDate >= dtmStartDate AND dtmTargetDate <= dtmEndDate

这句出错?

Tsql ="select * From  lssj where xfzl='消费' and xfsj between '" & data1 & "' and '"& data2 &"'"  'dtmTargetDate >= dtmStartDate AND dtmTargetDate <= dtmEndDate

这样就ok了