Import dữ liệu từ File đang đóng bị lỗi trường Ngày tháng năm

Gửi các thành viên GPE,
Em có sử dụng Code ADO để ImPort dữ liệu từ File đang đóng. Code sưu tầm của sư phụ @ndu96081631
Mọi người giải nén Folder Import Data về máy, Click RUN để Import dữ liệu:

Có một thực trạng như sau:
(1) Tại File nguồn (Source) những bản ghi có tháng <=12 thì khi Import về File đích bị đảo vị chí thành ngày, ví dụ 03/12/2018 thành 12/03/2018.
(2) Nhưng nếu mở File Nguồn, Click RUN thì trường ngày lại đúng.

Hình như thực trạng này có nói ở đâu đó trên GPE rồi mà em mò không ra.
Rất mong mọi người hỗ trợ chỉnh sửa.

Chi tiết Code sưu tầm:

Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)

Dim cnn As Object, rsData As Object
    Dim tmpArr, Arr
    Dim szConn As String, szSQL As String, Tmp As String
    Dim lR As Long, lC As Long, lVersn As Long
    On Error GoTo ErrHandler
        lVersn = Val(Application.Version)
    Set cnn = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

If lVersn < 12 Then
        szConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
        "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & ";IMEX=1"";"
    Else
        szConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
        "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & ";IMEX=1"";"
    End If
    If SheetName = "" Then
    Dim Dbs As Object, db As Object
    Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVersn < 12, "36", "120"))
    Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
    Tmp = db.TableDefs(0).Name
    Tmp = Replace(Tmp, "''", "'")
    SheetName = Tmp
    db.Close
    Set Dbs = Nothing: Set db = Nothing
    Else
    SheetName = SheetName & "$"
    End If
    cnn.Open szConn
    szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
    rsData.Open szSQL, cnn, 1, 1
    tmpArr = rsData.GetRows
    ReDim Arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1))
    If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
    Arr(0, lC) = rsData.Fields(lC).Name
    Next
    End If
    rsData.Close: cnn.Close
    For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
    Arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
    Next
    GetData = Arr
    Set rsData = Nothing: Set cnn = Nothing
    Exit Function
ErrHandler:
MsgBox Err.Description
Set rsData = Nothing: Set cnn = Nothing
End Function
Sub Data()
Application.ScreenUpdating = False
  Sheet1.[A2:C5000].ClearContents
  Dim FileName As String, SheetName As String, RangeAddress As String
  Dim Arr
  FileName = ActiveWorkbook.Path & "" & "Source.xlsm"
  SheetName = "Sheet1"
  RangeAddress = "A1:C5000"
  Arr = GetData(FileName, SheetName, RangeAddress, True, True)
    If IsArray(Arr) Then
      ThisWorkbook.Sheets("sheet1").[A1].Resize(UBound(Arr, 1) + 1, _
      UBound(Arr, 2) + 1).Value = Arr
    End If
Application.ScreenUpdating = True
End Sub
Sub Xoa()
Application.ScreenUpdating = False
Sheet1.[A2:C5000].ClearContents
Application.ScreenUpdating = True
End Sub

Cách khắc phục: trong file source em dùng text to column để chuyển cột date về dmy hoặc copy 1 ô trống rồi paste special value + add vào cột date.
Nguyên nhân tại sao thì chịu, trường hợp này anh thấy 1 số phần mềm xuất file excel hay bị, có thể do xung đột giữa định dạng ngày tháng năm của hệ thống và excel.

Tks a
Lâu quá ko gặp a.
Việc paste 0 vào dữ liệu e đã thực hiện ngay từ nguồn để ra file Source rồi ạ.

Sau khi file source chuyển như vậy thì tất cả ngày tháng ra đều đúng kể cả khi source đã đóng. Anh đoán có sự xung đột giữa định dạng của hệ thống và excel vì file source của em mặc dù đúng là date dạng ddmmyyyy nhưng có 1 số ô căn lề trái như text, số còn lại căn lề phải.

Căn trái (dạng text) với những ô có mm>12

Em chuyển định dạng ngày tháng năm trong control panel – regional settings và trong excel về dạng ddmmyyyy trước rồi mới dùng text to column hoặc cộng thêm 0.

Cái này e vẫn để mặc định vậy mà.

Em thử file source đã sửa này:

Em chưa xem,
Nhưng đang nghĩ hay thôi ko chơi kiểu hiện đại này mà chơi kiểu cổ điển: (1) mở file nguồn (2) copy dữ liệu (3) đóng file nguồn (4) paste vào file đích.

Đúng đấy, bỏ hết code đi. Copy paste thủ công!

www.giaiphapexcel.com/diendan/threads/import-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-file-%C4%91ang-%C4%91%C3%B3ng-b%E1%BB%8B-l%E1%BB%97i-tr%C6%B0%E1%BB%9Dng-ng%C3%A0y-th%C3%A1ng-n%C4%83m.135873/

Khóa học SprinGO phù hợp

Thiết kế Tổng đãi ngộ (Total Rewards) theo khung SHRM

Khóa học “Thiết kế Tổng phần thưởng (Total Reward) chuẩn khung SHRM” giúp bạn nắm vững toàn bộ hệ thống đãi ngộ theo chuẩn...

Xem khóa học