Tanggal Ekspor Untuk Excel Dengan Vb?

Saya menggunakan kode berikut untuk mengekspor data dari sebuah query untuk unggul. Semua karya besar kecuali tanggal di excel adalah salah. Ini menunjukkan tanggal impor seperti "83480" kapan harus 2005/4/10, saya tidak tahu kenapa?

Hanya pikiran adalah mungkin aku harus mengatur format untuk itu beberapa kolom di excel.

Saya telah tiga kali diperiksa untuk memastikan ia mendapatkan itu data dari kolom yang tepat dalam database. Jenis data dalam kolom database "DateDone" diatur ke Tanggal / Waktu.

Code:

Dim db As Database

Dim rs As Recordset

Dim WS As Workspace

Dim Max As Long

Dim oExcel As Object

Dim oBook As Object

Dim oSheet As Object

Dim row As Integer

'Start a new workbook in Excel

Set oExcel = CreateObject("Excel.Application")

Set oBook = oExcel.Workbooks.Add

'Add data to cells of the first worksheet in the new workbook

Set oSheet = oBook.Worksheets(1)

'Get data

Set WS = DBEngine.Workspaces(0)

Set db = DBEngine.OpenDatabase(dbfile, False, False, ";PWD=" & pwdstring)

Set rs = db.OpenRecordset("Select * from production where " & mnsearchfield & " Like " & Searchmore & " Order by " & mnsearchfield & " ASC")

If rs.RecordCount = 0 Then

MsgBox ("No records to send!"), vbInformation, "Finished"

rs.Close

Exit Sub

End If

rs.MoveFirst

'formating column size and putting in column names

oSheet.Range("A1:Z1").Font.Bold = True

oSheet.Range("b1").Value = "Employee Name"

oSheet.Range("C1").Value = "WorkCenter"

oSheet.Range("D1").Value = "# of Parts Done"

oSheet.Range("E1").Value = "Date Done"

oSheet.Range("F1").Value = "Job Order"

oSheet.Range("G1").Value = "Total EFF"

oSheet.Range("H1").Value = "Emp #"

oSheet.Range("I1").Value = "Shift"

oSheet.Range("J1").Value = "Part #"

oSheet.Range("b1").columnWidth = 15

oSheet.Range("c1").columnWidth = 15

oSheet.Range("d1").columnWidth = 12

oSheet.Range("e1").columnWidth = 15

oSheet.Range("f1").columnWidth = 12

oSheet.Range("g1").columnWidth = 12

oSheet.Range("h1").columnWidth = 10

oSheet.Range("i1").columnWidth = 10

oSheet.Range("j1").columnWidth = 10

'sets row as 3 so it starts putting fields in at row 3 not row one where the names are

row = 3

'looping the data into excel

Do Until rs.EOF = True

oSheet.Range("B" & row).Value = rs("fullname")

oSheet.Range("C" & row).Value = rs("workcenter")

oSheet.Range("D" & row).Value = rs("numofpartsdone")

oSheet.Range("E" & row).Value = rs("datedone")

oSheet.Range("F" & row).Value = rs("joborder")

oSheet.Range("G" & row).Value = rs("totaleff")

oSheet.Range("H" & row).Value = rs("empnum")

oSheet.Range("I" & row).Value = rs("workshift")

oSheet.Range("J" & row).Value = rs("partnum")

row = row + 1

rs.MoveNext

If rs.AbsolutePosition >= 500 Then

Exit Do

End If

Loop

'adding sum & avg labels and formula

oSheet.Range("D" & row).Font.Bold = True

oSheet.Range("D" & row).Value = "Sum of Parts"

oSheet.Range("D" & row + 1).Value = "=Sum(D2:D" & row & ")"

oSheet.Range("G" & row).Font.Bold = True

oSheet.Range("G" & row).Value = "Avg Eff"

oSheet.Range("G" & row + 1).Value = "=Average(G2:G" & row & ")"

rs.Close

db.Close

'Save the Workbook and View Excel

oBook.SaveAs (App.Path & " emp.xls")

oExcel.Visible = True

Rem oExcel.Quit

End Sub

Apa ada pertanyaan tambahan ? Apakah ini tampaknya seperti cara yang baik untuk pergi untuk melakukan apa yang saya inginkan harus dilakukan? Aku tidak tahu bahwa ini bahkan mungkin sampai aku melihat sebuah posting di sini tentang hal itu hari ini. Jadi aku mencobanya.

Source : http://www.bigresource.com/

Terima kasih sebelumnya
Anda ingin mencari refrensi dan contoh program lengkap ? Kami ada. Sekarang Anda bisa mencari Visual Basic 6.0 Program di situs ini : www.panduanSkripsi.net. Koleksi program lengkap di sana, proyek PHP dan MySQL, juga jQuery dan Framework. Bukunya juga ada.