DM Access To Excel

[DMT Dave]

Hi All, does anyone know what i am getting a number after transfer to Excel when the access field "delivery" is a Date field ? Thanks in advance, The following 5 numbers are copied from the excel result and should be date.
Can I use Format(Date) in the rs ?
Also rs4 is empty ? rs4 is based on status still in planning stage

DELIVERY

43431

43431

43431

43431

43431

#Dim mInput As Long, mYear As Long, intSheets As LongDim ApXL, XLWb, XlWs1, xlWs2, xlWs3, xlWs4, xlWs5, xlSheetLast As Object
Dim wsAdd1, wsAdd2 As Worksheet
Dim strPathName As String, mAsc As String, Cust As String, Src As String, mStatus As String
Dim rs, rs2, rs3, rs4, rs5 As DAO.Recordset
Dim mStart As Date, mEnd As Date


mStart = "01/01/2018"
mEnd = Me.txtUpdate
mStatus = "Pending"
strPathName = "T:" & "DMT DELIVERIES" & ".xlsx"
If Len(Dir(strPathName)) > 0 Then
Kill strPathName
End If
Cust = "Me.cboCustomer"
Src = "Acc"
mYear = DatePart("yyyy", mStart)
Set ApXL = CreateObject("Excel.Application")
Set XLWb = ApXL.Workbooks.Add
intSheets = XLWb.Worksheets.Count
Set xlSheetLast = XLWb.Worksheets(intSheets)
Set xlSheet = XLWb.Worksheets.Add(, xlSheetLast, 1, xlWorksheet)
ApXL.ActiveWorkbook.SaveAs (strPathName)
Set XLWb = ApXL.Workbooks.Open(strPathName)
ApXL.Visible = True
Set XlWs1 = XLWb.Worksheets("Sheet1")
XlWs1.Name = mYear & " " & "DELIVERIES"
Set xlWs2 = XLWb.Worksheets("Sheet2")
xlWs2.Name = mYear & " " & "COLLECTIONS"
Set xlWs3 = XLWb.Worksheets("Sheet3")
xlWs3.Name = "DMT ADDED"
'Set xlWs4 = XLWb.Worksheets("Sheet4")
'xlWs4.Name = "DELIVERIES TO GO THIS WEEK"


Set rs = CurrentDb.OpenRecordset("SELECT tblAssign.SONumber, tblAssign.DelTo, tblAssign.PONumber, tblAssign.LiftType, tblAssign.LiftNo, tblAssign.DeliveryDate FROM tblAssign WHERE DeliveryDate Between #" & mStart & "# And #" & mEnd & "#" & " And Customer = '" & Cust & "'" & " And SOURCE = '" & Src & "' ORDER BY DeliveryDate Desc")
Set rs2 = CurrentDb.OpenRecordset("SELECT tblCollections.SONumber, tblCollections.DelTo, tblCollections.PONumber, tblCollections.LiftType, tblCollections.LiftNo, tblCollections.CollectedDate FROM tblCollections WHERE CollectedDate Between #" & mStart & "# And #" & mEnd & "#" & " And Customer = '" & Cust & "'" & " And SOURCE = '" & Src & "' ORDER BY CollectedDate Desc")
Set rs3 = CurrentDb.OpenRecordset("SELECT tblEdit.SONumber, tblEdit.DelTo, tblEdit.PONumber, tblEdit.LiftType, tblEdit.LiftNo, tblEdit.ShipmentDate FROM tblEdit WHERE Customer = '" & Cust & "'" & " And SOURCE = '" & Src & "'" & " And ShipmentDate Is NULL")
Set rs4 = CurrentDb.OpenRecordset("SELECT tblEdit.SONumber, tblEdit.DelTo, tblEdit.PONumber, tblEdit.LiftType, tblEdit.LiftNo FROM tblEdit WHERE Customer = '" & Cust & "'" & " And SOURCE = '" & Src & "'" & " And Status = '" & mStatus & "' ORDER BY SONumber Desc")


Set XLWb = ApXL.Workbooks.Open(strPathName)
With XLWb
.Worksheets(1).Cells(1) = "PRESS AND HOLD 'CTRL'"
.Worksheets(1).Cells(2, 1) = "AND PRESS 'F' KEY"
.Worksheets(1).Cells(3, 1) = "WHEN THE SEARCH BOX APPEARS"
.Worksheets(1).Cells(4, 1) = "TYPE YOUR SEARCH"
.Worksheets(1).Cells(1, 3) = "SL-NUMBER"
.Worksheets(1).Cells(1, 4) = "DEALER"
.Worksheets(1).Cells(1, 5) = "PO-NUMBER"
.Worksheets(1).Cells(1, 6) = "LIFT TYPE"
.Worksheets(1).Cells(1, 7) = "LIFT DETAILS"
.Worksheets(1).Cells(1, 8) = "DELIVERY"
.Worksheets(1).Cells(3, 3).CopyFromRecordset rs
.Worksheets(1).Range("C3:H3").Borders(xlEdgeTop).L ineStyle = xlContinuous
.Worksheets(1).Cells.EntireColumn.AutoFit
.Worksheets(1).Cells.EntireColumn.HorizontalAlignm ent = xlLeft


.Worksheets(2).Cells(1) = "PRESS AND HOLD CTRL"
.Worksheets(2).Cells(2, 1) = "AND PRESS F KEY"
.Worksheets(2).Cells(3, 1) = "WHEN THE SEARCH BOX APPEARS"
.Worksheets(2).Cells(4, 1) = "TYPE YOUR SL-NUMBER"
.Worksheets(2).Cells(1, 3) = "SL-NUMBER"
.Worksheets(2).Cells(1, 4) = "DEALER"
.Worksheets(2).Cells(1, 5) = "PO-NUMBER"
.Worksheets(2).Cells(1, 6) = "LIFT TYPE"
.Worksheets(2).Cells(1, 7) = "LIFT DETAILS"
.Worksheets(2).Cells(1, 8) = "COLLECTION"
.Worksheets(2).Cells(3, 3).CopyFromRecordset rs2
.Worksheets(2).Range("C3:H3").Borders(xlEdgeTop).L ineStyle = xlContinuous
.Worksheets(2).Cells.EntireColumn.AutoFit
.Worksheets(2).Cells.EntireColumn.HorizontalAlignm ent = xlLeft


.Worksheets(3).Cells(1) = "PRESS AND HOLD CTRL"
.Worksheets(3).Cells(2, 1) = "AND PRESS F KEY"
.Worksheets(3).Cells(3, 1) = "WHEN THE SEARCH BOX APPEARS"
.Worksheets(3).Cells(4, 1) = "TYPE YOUR SL-NUMBER"
.Worksheets(3).Cells(1, 3) = "SL-NUMBER"
.Worksheets(3).Cells(1, 4) = "DEALER"
.Worksheets(3).Cells(1, 5) = "PO-NUMBER"
.Worksheets(3).Cells(1, 6) = "LIFT TYPE"
.Worksheets(3).Cells(1, 7) = "LIFT DETAILS"
.Worksheets(3).Cells(1, 8) = "SHIPMENT DATE"
.Worksheets(3).Cells(3, 3).CopyFromRecordset rs3
.Worksheets(3).Range("C3:H3").Borders(xlEdgeTop).L ineStyle = xlContinuous
.Worksheets(3).Cells.EntireColumn.AutoFit
.Worksheets(3).Cells.EntireColumn.HorizontalAlignm ent = xlLeft


.Worksheets(4).Cells(1) = "PRESS AND HOLD CTRL"
.Worksheets(4).Cells(2, 1) = "AND PRESS F KEY"


.Worksheets(4).Cells(3, 1) = "WHEN THE SEARCH BOX APPEARS"
.Worksheets(4).Cells(4, 1) = "TYPE YOUR SL-NUMBER"
.Worksheets(4).Cells(1, 3) = "SL-NUMBER"
.Worksheets(4).Cells(1, 4) = "DEALER"
.Worksheets(4).Cells(1, 5) = "PO-NUMBER"
.Worksheets(4).Cells(1, 6) = "LIFT TYPE"
.Worksheets(4).Cells(1, 7) = "LIFT DETAILS"
.Worksheets(4).Cells(1, 8) = "PENDING"
.Worksheets(4).Cells(3, 3).CopyFromRecordset rs4
.Worksheets(4).Range("C3:H3").Borders(xlEdgeTop).L ineStyle = xlContinuous
.Worksheets(4).Cells.EntireColumn.AutoFit
.Worksheets(4).Cells.EntireColumn.HorizontalAlignm ent = xlLeft


.Save


End With
Set rs = Nothing
Set rs2 = Nothing
Set ApXL = Nothing


If MsgBox("Copy To" & " " & me.cboCustomer & " " & Folder ?", vbQuestion + vbYesNo, "COPY SEARCH FILE") = vbNo Then
DoCmd.CancelEvent
Else
FileCopy "T:\DMT DELIVERIES" & ".xlsx", "T:" & Me.cboCustomer & "" & "SL SEARCH" & " " & Format(Me.txtUpdate, "dd-mm-yy") & ".xlsx"
End If#

[pbaldy]

Yes, you can use the Format() function in the recordset SQL. You can use this to see how the SQL comes out and perhaps lead you to why there are no records being returned:

http://www.baldyweb.com/ImmediateWindow.htm

[ssanfu]

Be aware that your declarations are not doing what you think.

You have

Dim ApXL, XLWb, XlWs1, xlWs2, xlWs3, xlWs4, xlWs5, xlSheetLast As Object
Dim wsAdd1, wsAdd2 As Worksheet
Dim rs, rs2, rs3, rs4, rs5 As DAO.Recordset

In the first Dim statement, the variables ApXL, XLWb, XlWs1, xlWs2, xlWs3, xlWs4 & xlWs5 are being declared as type Variant - only xlSheetLast is being declared as an Object.

In the second dim statement, wsAdd1 is being declared as a Variant and wsAdd2 is being declared as a Worksheet.

In the third dim statement, rs, rs2, rs3 & rs4 are being declared as type Variant - only rs5 is being declared as a DAO.Recordset.

You MUST EXPLICITLY declare variables (unless you want them to be Variants):

Dim ApXL As Object, XLWb As Object, XlWs1 As Object, xlWs2 As Object, xlWs3 As Object, xlWs4 As Object, xlWs5, xlSheetLast As Object
Dim wsAdd1 As Worksheet, wsAdd2 As Worksheet
Dim rs As DAO.Recordset, rs2 As DAO.Recordset, rs3 As DAO.Recordset, rs4 As DAO.Recordset, rs5 As DAO.Recordset

[DMT Dave]

Hi Guys, thank you for your info, i have now changed each Dim to their own declaration as advised, tblEdit.DeliveryDate within the rs line is outputting to Excel still as a 5 digit number, is there something in the excel WS where i can force it to date, i have tried playing around with something like
.Worksheets.Cells("H3:H10000").NumberFormat = "dd-mmm-yyyy")

This doesn't work either, i know the easiest way is to right click Column H in Excel and convert selection to Date format but eventually I am trying to do this without opening XL and copying straight to Customer updates

Also even after declaring each rs as a DAO.Recordset

rs4 is still outputting blank when i know i Have got pending jobs in the status field!!!

Cust is a string
mStatus Is A String
Src is a String (Field Called Source)

Cust = Me.Customer
Status = "Pending"
Src = "Acc" (This is because 1 Customer has more than 1 branch, this field is to verify Branch)

Set rs4 = CurrentDb.OpenRecordset("SELECT tblEdit.SONumber, tblEdit.DelTo, tblEdit.PONumber, tblEdit.LiftType, tblEdit.LiftNo FROM tblEdit WHERE Customer = '" & Cust & "'" & " And Source = '" & Src & "'" & " And Status = '" & mStatus & "' ORDER BY DelTo;")

Much appreciated

[pbaldy]

Did you try the link in post 2?

And I was suggesting the Format() function in the SQL:

Format(tblEdit.ShipmentDate, 'Short Date') As DateField