Excel查询表上的格式问题

时间:2018-07-16 09:17:43

标签: sql excel excel-vba ms-access-2010 excelquery

我正在尝试使用Excel中的SQL查询提取数据。查询工作正常并给出准确的结果,但是问题是我在查询中传递了日期变量01-02-2005并获得了输出-2006(最后一列)。据我所知,我尝试了许多可能的方法,但这是行不通的Query Result。请建议如何获取自定义日期2005年1月2日。

参考代码

Sub CreateGLTable()

    Const adOpenKeyset = 1
    Const adLockOptimistic = 3
    Const WORKSHEETNAME As String = "Sheet1"
    Const TABLENAME As String = "Table1"

    Dim conn As Object, rs As Object
    Dim tbl As ListObject

    Dim Destination As Range





    Set Destination = ThisWorkbook.Worksheets("GL_OUTPUT").Range("a1")
    Set conversiongl = ThisWorkbook.Worksheets("GL_OUTPUT")
    ThisWorkbook.Worksheets("GL_MEMO").Range("E1").NumberFormat = "@"
    Set rg = ThisWorkbook.Worksheets("GL_MEMO").UsedRange
    Set tbl = ThisWorkbook.Worksheets("GL_MEMO").ListObjects.Add(xlSrcRange, rg, , xlYes)

    With tbl.Sort
    .SortFields.Clear
        .SortFields.Add _
            Key:=.Parent.ListColumns("NATURAL_ACCOUNT").DataBodyRange, SortOn:=xlSortOnValues, Order:= _
            xlDescending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Set tbl = Worksheets(WORKSHEETNAME).ListObjects(TABLENAME)

    Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

    conn.Open
    '  On Error GoTo CloseConnection
    Set rs = CreateObject("ADODB.Recordset")
    With rs
        .ActiveConnection = conn
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = getGLSQL(tbl)
        .Open

        With Destination
            'tbl.HeaderRowRange.Copy .Range("c1")
            .Range("a1").CopyFromRecordset rs
            .Parent.ListObjects.Add SourceType:=xlSrcRange, Source:=.Range("a1").CurrentRegion, XlListObjectHasHeaders:=xlYes, TableStyleName:=tbl.TableStyle

        End With
    End With

    tbl.Unlist
CloseRecordset:
    rs.Close
    Set rs = Nothing
CloseConnection:
    conn.Close
    Set conn = Nothing

conversiongl.Copy
    With Workbooks(Workbooks.Count)
    .SaveAs Filename:="E:\GL.glm", FileFormat:=xlCSV, CreateBackup:=False
    .Close False
End With


End Sub


Function getGLSQL(tbl As ListObject) As String
    Dim SQL As String, SheetName As String, RangeAddress As String
        Dim strcur, strbranch, strSource, StrtimeStampDate  As String


    strcur = "'INR'"
    strbranch = "'CHEN'"
    strSource = "'Northern Arc'"
    StrtimeStampDate = ThisWorkbook.Worksheets("sheet2").Range("b2").Value


SQL = " SELECT " & strbranch & " as [Branch]" & _
         ", " & strcur & " as [CURRENCY]" & _
        ", [NATURAL_ACCOUNT]" & _
        ",  Left([gl_desc_2], 50) as [gl_desc_2]" & _
        ", IIF(isnull([AMT]), 0, [AMT]) as [AMT1]" & _
        ", IIF(isnull([AMT]), 0, [AMT]) as [AMT2]" & _
        ",  " & strSource & "  as [SOURCE] " & _
        ",  " & StrtimeStampDate & " as [TimeStamp] " & _
        " FROM" & _
      "( SELECT sum([NET]) * -1 AS [AMT]" & _
       ", [NATURAL_ACCOUNT] as  [NATURAL_ACCOUNT]" & _
       ", [gl_desc_2]" & _
       " FROM [SheetName$RangeAddress] " & _
       " group by  ([natural_account]), [gl_desc_2] )"

   'SQL = "Select [NATURAL_ACCOUNT] FROM [SheetName$RangeAddress] "


    SheetName = tbl.Parent.Name
    RangeAddress = tbl.Range.Address(False, False)
Debug.Print SheetName
Debug.Print RangeAddress
    SQL = Replace(SQL, "SheetName", SheetName)
    SQL = Replace(SQL, "RangeAddress", RangeAddress)

    getGLSQL = SQL
End Function

1 个答案:

答案 0 :(得分:0)

更改

 StrtimeStampDate = ThisWorkbook.Worksheets("sheet2").Range("b2").Value

收件人

StrtimeStampDate = "#" &  Format(ThisWorkbook.Worksheets("sheet2").Range("b2").Value,"dd mmm yyyy") & "#"