I have a txt file on my local PC, this has to be check and then line by line uploaded into SQL Server 2016 using a Stored Procedure from MS Access using ADODB. It looks like Access is running always 2 rows fast and then making a short stop.
In MS Access I'm using this function:
Public Function ImportData(FileString As String)
Dim WholeLine As String
Dim cc As Variant
Dim sapPurchaseDocument As String
Dim sapPartNumber As String
Dim sapPartName As String
Dim sapDocumentDate As String
Dim sapSupplier As String
Dim sapPlant As String
Dim sapSLoc As String
Dim sapQuantity As Double
Dim sapUOM As String
Dim sapTargetQuantity As Double
Dim sapDeliveryDate As String
Dim sapPrevQuantity As Double
Dim sapReceivedQuantity As Double
Dim sapIssuedQuantity As Double
Dim sapDeliveredQuantity As Double
Dim sapPurchaseRequisition As String
Dim sapPurchaseRequisitionItem As String
Dim sapCreationIndicatior As String
Dim sapNoOfPositions As Double
Dim totalCount As Integer
Dim sapPurchaseDocumentItem As String
Dim rs As New ADODB.Recordset
Call GetConnection
Set rs.ActiveConnection = myCN
If Right(FileString, 3) = "txt" Then
totalCount = GetRowCount(FileString)
Open FileString For Input As #1
i = 0
Do While Not EOF(1)
Line Input #1, WholeLine
If Left(WholeLine, 3) = "| 4" Then
'Debug.Print WholeLine
cc = Split(WholeLine, "|")
sapPurchaseDocument = Trim(cc(1))
sapPartNumber = Trim(Replace(cc(2), ".", ""))
sapPartName = Trim(Replace(cc(3), "'", ""))
sapDocumentDate = Right(cc(4), 4) & "-" & Mid(cc(4), 4, 2) & "-" & Left(cc(4), 2)
sapSupplier = cc(5)
sapPlant = cc(6)
sapSLoc = cc(7)
sapQuantity = Replace(cc(8), ",", "")
sapUOM = Trim(cc(9))
sapTargetQuantity = Replace(cc(10), ",", "")
sapDeliveryDate = Right(cc(11), 4) & "-" & Mid(cc(11), 4, 2) & "-" & Left(cc(11), 2)
sapPrevQuantity = cc(12)
sapReceivedQuantity = Replace(cc(13), ",", "")
sapIssuedQuantity = Replace(cc(14), ",", "")
sapDeliveredQuantity = Replace(cc(15), ",", "")
sapPurchaseRequisition = Trim(cc(16))
sapPurchaseRequisitionItem = Trim(cc(17))
sapCreationIndicatior = cc(18)
sapNoOfPositions = cc(19)
sapPurchaseDocumentItem = Trim(cc(20))
strSQL = "spInsertUpdateSAPME2M '" & sapPurchaseDocument & "', '" & sapPartNumber & "', '" & sapPartName & "', '" & _
sapDocumentDate & "', '" & sapSupplier & "', '" & sapPlant & "', '" & sapSLoc & "', " & _
sapQuantity & ", '" & sapUOM & "', " & sapTargetQuantity & ", '" & sapDeliveryDate & "', " & _
sapPrevQuantity & ", " & sapReceivedQuantity & ", " & sapIssuedQuantity & ", " & _
sapDeliveredQuantity & ", '" & sapPurchaseRequisition & "', '" & sapPurchaseRequisitionItem & "', '" & _
sapCreationIndicatior & "', '" & sapNoOfPositions & "', '" & sapPurchaseDocumentItem & "'"
rs.Open (strSQL)
DoEvents
End If
i = i + 1
Debug.Print i
Forms!frm_Overview.lblStatus.Caption = "Record " & i & " of " & totalCount & " loaded. Please wait!"
DoEvents
'Refresh
Loop
MsgBox "Import done"
End If
Close #1
End Function
And on SQL Server I have a stored procedure which looks like this:
USE [MOBILEPRINT]
GO
/****** Object: StoredProcedure [dbo].[spInsertUpdateSAPME2M] Script Date: 5/25/2020 11:39:31 AM ******/
SET ANSI_NULLS OFF
GO
SET QUOTED_IDENTIFIER ON
GO
CHANGE NO ACTION
ALTER PROCEDURE [dbo].[spInsertUpdateSAPME2M]
-- Add the parameters for the stored procedure here
#sapPurchaseDocument varchar(50),
#sapPartNumber varchar(50),
#sapPartName varchar(300),
#sapDocumentDate date,
#sapSupplier varchar(50),
#sapPlant varchar(100),
#sapSLoc varchar(50),
#sapQuantity float,
#sapUOM varchar(50),
#sapTargetQuantity float,
#sapDeliveryDate date,
#sapPrevQuantity float,
#sapReceivedQuantity float,
#sapIssuedQuantity float,
#sapDeliveredQuantity float,
#sapPurchaseRequisition varchar(50),
#sapPurchaseRequisitionItem varchar(50),
#sapCreationIndicatior varchar(50),
#sapNoOfPositions varchar(50),
#sapPurchaseDocumentItem varchar(50)
AS
BEGIN TRANSACTION
-- SET NOCOUNT ON added to prevent extra result sets from
-- interfering with SELECT statements.
SET NOCOUNT ON;
DECLARE #RESULT int
DECLARE #UPDATE_CHECK int
DECLARE #UpdateDate datetime = GetDate()
BEGIN
SELECT #RESULT = COUNT(sapPurchaseDocument) FROM SAP_ME2M WHERE sapPurchaseDocument = #sapPurchaseDocument AND sapPartNumber = #sapPartNumber
IF ISNULL(#RESULT,0) = 0
BEGIN
INSERT INTO SAP_ME2M (
sapPurchaseDocument,
sapPartNumber,
sapPartName,
sapDocumentDate,
sapSupplier,
sapPlant,
sapSLoc,
sapQuantity,
sapUOM,
sapTargetQuantity,
sapDeliveryDate,
sapPrevQuantity,
sapReceivedQuantity,
sapIssuedQuantity,
sapDeliveredQuantity,
sapPurchaseRequisition,
sapPurchaseRequisitionItem,
sapCreationIndicatior,
sapNoOfPositions,
ChangeDate,
sapPurchaseDocumentItem)
VALUES
(#sapPurchaseDocument, #sapPartNumber, #sapPartName, #sapDocumentDate, #sapSupplier, #sapPlant,
#sapSLoc, #sapQuantity, #sapUOM, #sapTargetQuantity, #sapDeliveryDate, #sapPrevQuantity,
#sapReceivedQuantity, #sapIssuedQuantity, #sapDeliveredQuantity, #sapPurchaseRequisition,
#sapPurchaseRequisitionItem, #sapCreationIndicatior, #sapNoOfPositions, #UpdateDate, #sapPurchaseDocumentItem)
END
ELSE
SELECT #UPDATE_CHECK = COUNT(*) FROM SAP_ME2M WHERE
sapPurchaseDocument = #sapPurchaseDocument AND
sapPartNumber = #sapPartNumber AND
sapPartName = #sapPartName AND
sapDocumentDate = #sapDocumentDate AND
sapSupplier = #sapSupplier AND
sapPlant = #sapPlant AND
sapSLoc = #sapSLoc AND
sapQuantity = #sapQuantity AND
sapUOM = #sapUOM AND
sapTargetQuantity = #sapTargetQuantity AND
sapDeliveryDate = #sapDeliveryDate AND
sapPrevQuantity = #sapPrevQuantity AND
sapReceivedQuantity = #sapReceivedQuantity AND
sapIssuedQuantity = #sapIssuedQuantity AND
sapDeliveredQuantity = #sapDeliveredQuantity AND
sapPurchaseRequisition = #sapPurchaseRequisition AND
sapPurchaseRequisitionItem = #sapPurchaseRequisitionItem AND
sapCreationIndicatior = #sapCreationIndicatior AND
sapNoOfPositions = #sapNoOfPositions AND
sapPurchaseDocumentItem = #sapPurchaseDocumentItem
IF #UPDATE_CHECK = 0
BEGIN
UPDATE SAP_ME2M SET
sapPartName = #sapPartName ,
sapDocumentDate = #sapDocumentDate ,
sapSupplier = #sapSupplier ,
sapPlant = #sapPlant ,
sapSLoc = #sapSLoc ,
sapQuantity = #sapQuantity ,
sapUOM = #sapUOM ,
sapTargetQuantity = #sapTargetQuantity ,
sapDeliveryDate = #sapDeliveryDate ,
sapPrevQuantity = #sapPrevQuantity ,
sapReceivedQuantity = #sapReceivedQuantity ,
sapIssuedQuantity = #sapIssuedQuantity ,
sapDeliveredQuantity = #sapDeliveredQuantity ,
ChangeDate = #UpdateDate
WHERE
sapPartNumber = #sapPartNumber AND
sapPartName = #sapPartName AND
sapDocumentDate = #sapDocumentDate AND
sapSupplier = #sapSupplier AND
sapPlant = #sapPlant AND
sapSLoc = #sapSLoc AND
sapPurchaseDocumentItem = #sapPurchaseDocumentItem
END
END
COMMIT TRANSACTION WITH (DELAYED_DURABILITY = ON);
I have to upload around 30000 Records which takes more then an hour at the moment.
If you have suggestions, please let me know.
For fast data transfer, use a disconnected recordset with batch operations enabled.
Dim conn As ADODB.Connection
Call GetConnection
Set conn = myCN
Dim rs As New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "Table1", conn, adOpenForwardOnly, adLockBatchOptimistic
'Disconnect
Set rs.ActiveConnection = Nothing
Dim i As Long
For i = 1 To 3000
rs.AddNew
rs.Fields(1) = i
Next
'Reconnect
Set rs.ActiveConnection = conn
'Batch insert
rs.UpdateBatch
Debug.Print Now()
For me, this executes in 2 seconds, but it highly depends on the location of SQL server.
Then, process further on the data set when uploaded. Processing on a per-record basis is usually going to be slow.
My query works in VBA code, but I will have a lot of this kind of queries, so I don't want to create a new "rst" section every time. (recordset).
The code I created is below.
Private Sub wpr_krotkaNazwaProjektu_AfterUpdate()
Dim rst4 As DAO.Recordset
Dim rst5 As DAO.Recordset
Dim strSql4 As String
Dim strSql5 As String
Dim krotkaNazwaProjektu4 As String
Dim krotkaNazwaProjektu5 As String
krotkaNazwaProjektu4 = wpr_krotkaNazwaProjektu.Text
krotkaNazwaProjektu5 = wpr_krotkaNazwaProjektu.Text
strSql4 = "SELECT Ewidencje.E_dataRozpoczeciaProjektu from Ewidencje INNER JOIN KP_KartyProjektow on Ewidencje.ID_kartyProjektu = KP_KartyProjektow.ID_kartyProjektu WHERE KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & (krotkaNazwaProjektu4) & "' "
strSql5 = "SELECT Ewidencje.E_dataPlanowaneZakonczenieProjektu from Ewidencje INNER JOIN KP_KartyProjektow on Ewidencje.ID_kartyProjektu = KP_KartyProjektow.ID_kartyProjektu WHERE KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & (krotkaNazwaProjektu5) & "' "
Set rst4 = CurrentDb.OpenRecordset(strSql4)
Set rst5 = CurrentDb.OpenRecordset(strSql5)
przypisanie4 = rst4!E_dataRozpoczeciaProjektu
przypisanie5 = rst5!E_dataPlanowaneZakonczenieProjektu
rst4.Close
Set rst4 = Nothing
rst5.Close
Set rst5 = Nothing
wpr_planowanaDS.Value = przypisanie4
wpr_planowanaDZ.Value = przypisanie5
End Sub
I don't want to open "rst" every time, whether such a query can be modified in such a way that it won't create many variables in ten queries.
I don't know if I understand you correctly.
Using the next code you should be able to do the same just using one variable for each thing:
Private Sub wpr_krotkaNazwaProjektu_AfterUpdate()
Dim rst As DAO.Recordset
Dim strSql As String
Dim krotkaNazwaProjektu As String
krotkaNazwaProjektu = wpr_krotkaNazwaProjektu.Text
strSql = "SELECT Ewidencje.E_dataRozpoczeciaProjektu from Ewidencje INNER JOIN KP_KartyProjektow on Ewidencje.ID_kartyProjektu = KP_KartyProjektow.ID_kartyProjektu WHERE KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & krotkaNazwaProjektu & "' "
Set rst = CurrentDb.OpenRecordset(strSql)
przypisanie = rst!E_dataRozpoczeciaProjektu
rst.Close
wpr_planowanaDS.Value = przypisanie
strSql = "SELECT Ewidencje.E_dataPlanowaneZakonczenieProjektu from Ewidencje INNER JOIN KP_KartyProjektow on Ewidencje.ID_kartyProjektu = KP_KartyProjektow.ID_kartyProjektu WHERE KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & krotkaNazwaProjektu & "' "
Set rst = CurrentDb.OpenRecordset(strSql)
przypisanie = rst!E_dataPlanowaneZakonczenieProjektu
rst.Close
wpr_planowanaDZ.Value = przypisanie
Set rst = Nothing
End Sub
The use of non-English names makes it impossible to figure out what your data is about but you could try something like this:
"SELECT IIF(KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & (krotkaNazwaProjektu4) & "',Ewidencje.E_dataRozpoczeciaProjektu,NULL) AS KP_krotkaNazwaProjektu
IIF(KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & (krotkaNazwaProjektu5) & "',Ewidencje.E_dataPlanowaneZakonczenieProjektu,NULL) AS E_dataPlanowaneZakonczenieProjektu
FROM Ewidencje
INNER JOIN KP_KartyProjektow on Ewidencje.ID_kartyProjektu = KP_KartyProjektow.ID_kartyProjektu
WHERE KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & (krotkaNazwaProjektu4) & "' OR KP_KartyProjektow.KP_krotkaNazwaProjektu = '" & (krotkaNazwaProjektu5) & "'"
It combines your two queries into one. It can probably be simplified quite a bit if I understood what it is about and which field names are unique between the two linked tables and there may be a quote missing here or there that you may have to troubleshoot.
I have an issue with a project I am working on and updating a string within an array when a loop is initiated.
To provide a little context, the code is to amend errors that user's may have made when entering information and to update all the related tables in the one go.
Option Compare Database
Dim Var1 As Variant, SQL_select As Variant, SQL_update As Variant, newVar1 As String
Dim j As Integer, rsField As Variant, n As Variant
Public Sub amendCust_control()
Dim db As Database, rs As Recordset, cntRec As Integer, i As Integer, SQL_s As String, SQL_u As String
For j = 0 To 3
Var1 = Forms!mm_amendcustomer_temp!Var1
newVar1 = Forms!mm_amendcustomer_temp!Text50
assSelArray
SQL_s = SQL_select(j)
Set db = CurrentDb
Set rs = db.OpenRecordset(SQL_s)
If rs.EOF Then
cntRec = 0
Else
rs.MoveLast
cntRec = rs.RecordCount
End If
If cntRec > 0 Then
ReDim n(0 To (cntRec - 1))
rs.MoveFirst
For i = 0 To (cntRec - 1)
n(i) = rs.Fields(rsField(j))
assignSQLuparray 'populates update field with current value of n(j)
SQL_u = SQL_update(j)
Set SQL_update = Nothing
rs.MoveNext
Next i
Else
Exit Sub
End If
Set rs = Nothing
Set db = Nothing
Next j
Set rs = Nothing
Set db = Nothing
End Sub
I have then split my three string arrays between 2 subs, as below.
Private Sub assSelArray()
SQL_select = Array(("SELECT [Var1] FROM [Customer] WHERE [Var1] = '" & Var1 & "'"), _
("SELECT [transNo] FROM [Transactions] WHERE [Var1] = '" & Var1 & "'"), _
("SELECT [VAR_O] FROM [Overpayment] WHERE [Var1] = '" & Var1 & "'"), _
("SELECT [Access ID] FROM [Audit History] WHERE [Var1] = '" & Var1 & "'"))
rsField = Array("Var1", "transNo", "VAR_O", "[Access ID]")
End Sub
This is the array I am having difficulty with as the values of n(i) do not update on each iteration on the code, i.e. when n(i) changes value in the main sub, it does not do so in the array.
Private Sub assignSQLuparray()
SQL_update = Array(("UPDATE [Customer] SET Var1 = '" & newVar1 & "' WHERE Var1 = '" & n(i) & "'"), _
("UPDATE [Transactions] SET Var1 = '" & newVar1 & "' WHERE transNo = '" & n(i) & "'"), _
("UPDATE [Overpayment] SET Var1 = '" & newVar1 & "' WHERE VAR_O = '" & n(i) & "'"), _
("UPDATE [Audit History] SET Var1 = '" & newVar1 & "' WHERE [Access ID] = '" & n(i) & "'"))
End Sub
I had hoped someone may be able to help me to essentially 'refresh' the array values before calling them. Help?
The output was as below:
n(0) = 5
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(1) = 6
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(2) = 7
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(3) = 8
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
n(4) = 11
UPDATE [Audit History] SET Var = newVar1 WHERE [Access ID] = '5'
Notice the Access ID does not change as it should to n(0 to 4).
I'm really sorry to be asking and I'm sure it's extremely simple to answer but whenever I try to run the macro in excel below, I get the error message stated in the title:
Sub CallsMacro()
Dim ConData As ADODB.Connection
Dim rstData As ADODB.Recordset
Dim wsSheet As Worksheet
Dim strServer As String
Dim strDatabase As String
Dim strFrom As String
Dim strto As String
Dim intCount As Integer
Set wsSheet = ActiveWorkbook.Worksheets("Refresh")
With wsSheet
strServer = "TNS-CCR-02"
strDatabase = "AvayaSBCCRT"
strFrom = .Range("C$2")
strto = .Range("C$3")
End With
Set ConData = New ADODB.Connection
With ConData
.ConnectionString = "Provider=SQLOLEDB;Data Source=" & strServer & ";" & "Initial Catalog=" & ";" & "persist security info=true;" & "User Id=dashboard; Password=D4$hboard;"
.CommandTimeout = 1800
.Open
End With
''Create the recordset from the SQL query
Set rstData = New ADODB.Recordset
Set wsSheet = ActiveWorkbook.Worksheets("Calls")
With rstData
.ActiveConnection = ConData
.Source = "SELECT DISTINCT CAST(c.createdate AS date) as [Date]," & _
"CASE WHEN c.[CategoryID] = 1 then 'Outbound' WHEN c.[CategoryID] = 2 then 'Inbound' Else 'Internal' end as [Direction], c.cli as [Number], c.ddi, 'CallCentre' as [Queue], '' as [Queue Time], u.username as [Agent], cast((c.DestroyDate - c.CreateDate) as TIME) as [Duration], 'Connected' as [Status], c.callID as [Reference]" & _
"FROM [AvayaSBCCRT].[dbo].[tblAgentActivity] as a" & _
"JOIN [AvayaSBCCRT].[dbo].[tblCallList] as c on c.calllistid = a.calllistid" & _
"JOIN [AvayaSBCCRT].[dbo].[tblUsers] as u on u.userid = a.AgentID" & _
"WHERE c.createdate between '" & strFrom & "' and '" & strto & "'" & _
"AND a.[ActivityID] = 3 "
.CursorType = adOpenForwardOnly
.Open
End With
wsSheet.Activate
Dim Lastrow As Long
Lastrow = Range("A" & Rows.Count).end(xlUp).Row
Range("A2:J" & Lastrow).ClearContents
If rs.EOF = False Then wsSheet.Cells(2, 1).CopyFromRecordset rsData
rs.Close
Set rs = Nothing
Set cmd = Nothing
con.Close
Set con = Nothing
End Sub
I've looked high and low and cannot find the reason for it. Anybody have any ideas?
You're missing spaces from the end of the lines. Your SQL contains for example:
[tblAgentActivity] as aJOIN [AvayaSBCCRT].[dbo].[tblCallList]
I'm importing data from oracle toad database into an Excel sheet using data connection. The table includes a Date column, but this column comes to Excel as text rather than the date.
Is there any way I can fix this issue?
Sub Show_data()
Dim con As ADODB.Connection
Dim recset As ADODB.Recordset
Dim ConnectionString As String
Dim strSQL As String
Dim iCols As Integer
Set con = New ADODB.Connection
Set recset = New ADODB.Recordset
'Check for the connectivity or connected to the xx network
On Error GoTo errHandler
ConnectionString = "Provider=xx;User ID=yy;password= appsro;Data Source=zz"
con.Open ConnectionString
'Set and Excecute SQL Command'
strSQL = "SELECT B.USER_NAME AS CREATED_BY, A.CREATION_DATE, C.USER_NAME, A.LAST_UPDATE_DATE, A.PFIZER_ITEMCODE, A.SYSTEM_ITEMCODE AS ORACLE_ITEM_CODE, " & _
"A.ITEM_DESCRIPTION, A.BATCH_NUMBER, A.MFR_CODE, A.MFR_DESC AS MFR_DESCRIPTION, TO_CHAR(A.MFR_DATE,'DD-MON-YYYY')As MFR_DATE, TO_CHAR(A.EXPIRY_DATE,'DD-MON-YYYY')As EXPIRY_DATE, " & _
"TO_CHAR(A.EFFECTIVE_FROM,'DD-MON-YYYY') AS EFFECTIVE_FROM, " & _
"A.EFFECTIVE_TO, A.EXCISE AS EXCISE_AMOUNT, A.EXCISE_RATE, A.P2S, A.P2R, A.MRP, A.STATE_CODE, A.STATE, " & _
"(CASE SUBSTR(A.SYSTEM_ITEMCODE,6,2) WHEN ('PI') THEN 'OIP' WHEN ('PF') THEN 'OPF' ELSE 'OWL' END )AS LEGAL_ENTITY " & _
"FROM xxdhl_pf_batch_pricing A JOIN fnd_user B ON A.CREATED_BY = B.USER_ID " & _
"JOIN fnd_user C ON A.LAST_UPDATED_BY = C.USER_ID WHERE "
If (ActiveSheet.cmbLE.Text) <> "" Then
strSQL = strSQL & " (CASE SUBSTR(A.SYSTEM_ITEMCODE,6,2) WHEN ('PI') THEN 'OIP' WHEN ('PF') THEN 'OPF' ELSE 'OWL' END )='" & ActiveSheet.cmbLE.Text & "'"
End If
If (ActiveSheet.cmbProduct.Text) <> "" Then
If (ActiveSheet.cmbLE.Text) <> "" Then
strSQL = strSQL & " AND A.SYSTEM_ITEMCODE='" & ActiveSheet.cmbProduct.Text & "'"
Else
strSQL = strSQL & " A.SYSTEM_ITEMCODE='" & ActiveSheet.cmbProduct.Text & "'"
End If
End If
If (ActiveSheet.txtBatch.Text) <> "" Then
If (ActiveSheet.cmbLE.Text) <> "" Or (ActiveSheet.cmbProduct.Text) <> "" Then
strSQL = strSQL & " AND A.BATCH_NUMBER='" & ActiveSheet.txtBatch.Text & "'"
Else
strSQL = strSQL & " A.BATCH_NUMBER='" & ActiveSheet.txtBatch.Text & "'"
End If
End If
If (ActiveSheet.txtfromdt.Text) <> "" Then
If (ActiveSheet.txtfromdt.Text) <> "" And (ActiveSheet.txtTodt.Text) <> "" Then
Else
strSQL = strSQL & " AND TRUNC(A.EFFECTIVE_FROM) BETWEEN TO_DATE('" & ActiveSheet.txtfromdt.Text & "','DD-MON-YYYY') AND TO_CHAR(SYSDATE ,'DD-MON-YYYY') "
End If
End If
If (ActiveSheet.txtfromdt.Text) <> "" And (ActiveSheet.txtTodt.Text) <> "" Then
If (ActiveSheet.cmbLE.Text) <> "" Or (ActiveSheet.cmbProduct.Text) <> "" Or (ActiveSheet.txtBatch.Text) <> "" Then
strSQL = strSQL & " AND TRUNC(A.EFFECTIVE_FROM) BETWEEN TO_DATE('" & ActiveSheet.txtfromdt.Text & "','DD-MON-YYYY') AND TO_DATE('" & ActiveSheet.txtTodt.Text & "','DD-MON-YYYY') "
Else
strSQL = strSQL & " TRUNC(A.EFFECTIVE_FROM) BETWEEN TO_DATE('" & ActiveSheet.txtfromdt.Text & "','DD-MON-YYYY') AND TO_DATE('" & ActiveSheet.txtTodt.Text & "','DD-MON-YYYY') "
End If
End If
'Open Recordset
Set recset.ActiveConnection = con
If recset.State = adStateOpen Then recset.Close
recset.CursorLocation = adUseClient
recset.Open strSQL, con, adOpenKeyset, adLockOptimistic
For iCols = 0 To recset.Fields.Count - 1
Worksheets("Sheet2").Cells(1, iCols + 1).Value = recset.Fields(iCols).Name
Next
'Copy the data
If recset.RecordCount > 0 Then
Sheets("Sheet2").Range("A2").CopyFromRecordset recset
Else
MsgBox "No Data Available", vbExclamation + vbOKOnly, ""
Exit Sub
End If
recset.Close
con.Close
errHandler:
If Err.Number = -2147467259 Then
MsgBox "Please check for the xx connectivity ", vbExclamation + vbOKOnly
Exit Sub
End If
End Sub
Actual result - 6/5/2015 4:12:47 PM but In Excel - 42160.67554
Please help :(
Which columns are you referring to as you have a mixture of logic when it comes to dates in your SQL query.
CREATION_DATE and LAST_UPDATE_DATE should work fine and simply need formatting like #KazimierzJawor said. Something like:-
Range("B5:B10, D5:D10").NumberFormat = "m/d/yyyy h:mm:ss AM/PM"
If you are referring to MFR_DATE, EXPIRY_DATE and EFFECTIVE_FROM columns, then you should remove the TO_CHAR functions as this is forcing the data to be text. Once you have removed the functions, you should be able to format those columns using the same technique as shown above.