通过excel VBA访问运行查询 - 运行时错误1004 - SQL语法错误

时间:2017-07-07 12:46:41

标签: excel vba excel-vba ms-access

尝试编辑前一名员工留下的旧代码并转到更新的系统,但只需复制最初写入的代码,我就会得到运行时错误'1004' - SQL语法错误。如果有人想指出我正确的方向,那么代码的副本如下?

粗体部分似乎是错误的地方......

Sub MIMacro()
'
'
    Sheets("MI_Report").Select
    Cells.Select
    Selection.ClearContents

    Dim StartDate As String

    Sheets("Date").Select

    StartDate = Range("D2").Value & "-" & Range("C2").Value & "-" & Range("B2").Value & " 00:00:00"

    Dim EndDate As String

    EndDate = Range("D3").Value & "-" & Range("C3").Value & "-" & Range("B3").Value & " 00:00:00"

    Sheets("MI_Report").Select

    Dim MySql As String
    MySql = "SELECT * FROM `W:\MI Reports\Imprint Reports.mdb`.XGSNOR_MI Katie L XGSNOR_MI Katie L WHERE (XGSNOR_MI Katie L.DelDate>={ts '" & StartDate & "'} And XGSNOR_MI Katie L.DelDate<={ts '" & EndDate & "'}) ORDER BY XGSNOR_MI Katie L.JobNo"

    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=W:\MI Reports\Imprint Reports.mdb;DefaultDir=W:\MI Reports;DriverId=25;FIL=MS Access;MaxBufferS" _
        ), Array("ize=2048;PageTimeout=5;")), Destination:=Range("A1"))
        .CommandText = Array(MySql)
        .Name = "Query from MS Access Database"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = True
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        **.Refresh BackgroundQuery:=False**
    End With

    Columns("E:E").Select
    Selection.NumberFormat = "General"
    Columns("C:C").Select
    Selection.NumberFormat = "m/d/yyyy"

    Range("A1").Select
    Selection.End(xlDown).Select
    lr1 = Selection.Row

    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Cost"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Total Pick Cost"
    Range("G2").Select

    Dim cost As Double
    Dim extra As Double
    Dim total As Double

    cost = 7#
    extra = 0.9
    total = 0#
    temp = "neworder"

    Dim e As Integer
    For e = 2 To lr1

        If temp = "neworder" Then
            temp = Range("A" & e).Value
            Range("G" & e).Select
            ActiveCell.FormulaR1C1 = cost
            total = total + cost
        Else
            temp = Range("A" & e).Value
            Range("G" & e).Select
            ActiveCell.FormulaR1C1 = extra
            total = total + extra
        End If

        temp2 = Range("A" & e + 1).Value

        If temp <> temp2 Then
            temp = "neworder"
            Range("H" & e).Select
            ActiveCell.FormulaR1C1 = total
            total = 0
        End If

    Next e

    Columns("G:H").Select
    Selection.NumberFormat = "$#,##0.00"

    Range("A1").Select

End Sub

1 个答案:

答案 0 :(得分:0)

我不熟悉该查询中使用的ODBC序列,所以不保证这会起作用:

MySql =行替换为

MySql = "SELECT * FROM [XGSNOR_MI Katie L] WHERE ([XGSNOR_MI Katie L].DelDate>={ts '" & StartDate & "'} And [XGSNOR_MI Katie L].DelDate<={ts '" & EndDate & "'}) ORDER BY [XGSNOR_MI Katie L].JobNo"

另外:应纠正以下几行:

With ActiveSheet.QueryTables.Add(Connection:= _
        "ODBC;DSN=MS Access Database;DBQ=W:\MI Reports\Imprint Reports.mdb;DefaultDir=W:\MI Reports;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;", _
         Destination:=Range("A1"))