Format Issue on Excel Query Table

186 Views Asked by At

I am trying to pull the data with SQL query in excel. Query working fine and giving exact result but issue is I am passing the date variable 01-02-2005 in query and getting output -2006 (Last Column). I tried many possible ways as of my knowledge , it's doesn't work Query Result. please suggest how to get the custom date 01-02-2005 .

refer code

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

There are 1 best solutions below

0
On

Change

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

To

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