ADODB recordset มีข้อจำกัดในการ Add record ไหม?

[gaka]

ADODB recordset มีข้อจำกัดในการ Add record ไหม?

ขอรบกวนสอบถาม เกี่ยวกับ ADODB.recordset
ผมทำการ load ข้อมูล ชุดนึง ประมาณ 160,000 records ในรูปแบบ xlsx เข้า accdb
คราวนี้ใช้การเขียน VBA บน Excel เพื่อใส่ข้อมูลเข้าไป

ไม่ได้ใช้ Copy & paste ลงใน Accdb โดยตรง เนื่องจาก บาง user ไม่ได้ลงไว้ในเครื่องให้ office ไม่ใช่โปรฯ
อันนี้ เป็น Script สร้าง Table ในฐานข้อมูล accdb
เอาไปรัน ใน SQL เลย นะ ไม่ต้องสร้างเองทีละคอลัมน์

Code: Select all

create table ar_p (
	AR_NO varchar(15) primary key,
	ref1 varchar(15) ,
	AREA_CODE varchar(10),
	REG_CODE varchar(20),
	DEP_CODE varchar(10),
	DEP_NAME_THA varchar(80),
	PRD_MD_CODE varchar(30),
	MPM_NAMETHI varchar(80),
	SERIAL_NO varchar(30),
	ARD_SALE_D datetime,
	ARD_CS_PRI double,
	ARD_HP_PRI double,
	ARD_DW_REQ double,
	ARD_MN_TRM long,
	ARD_CT_TRM double,
	ARD_AMT_FN double,
	ARD_HP_COL double,
	ARD_CUR_HP double,
	ARD_BAL double not null,
	ARD_MN_DEL long,
	ARD_MN_ARR long,
	ARD_LS_PYD datetime,
	ARD_CUR_AR double,
	CLAIM_FEE double,
	LATE_FEE double,
	ARM_ACC_STAT varchar(30),
	ARM_CLOSED_TYPE varchar(30),
	ARM_CLOSED_DATE Datetime,
	ARM_RED_FLAG varchar(5),
	CIDCARD varchar(15),
	CTITLE varchar(20),
	CFNAME varchar(80),
	CLNAME varchar(80),
	CADDRESS1 varchar(100),
	CADDRESS2 varchar(100),
	CADDRESS3 varchar(100),
	ZIP_CODE varchar(7),
	MobileNo1 varchar(30),
	TelephoneNo varchar(30),
	ExtensionNo varchar(30),
	ARD_OLD_ACNO varchar(30),
	ARD_OLD_SH varchar(30),
	OAREA_CODE varchar(10),
	OREG_CODE varchar(10),
	ODEP_NAME_THA varchar(80),
	C_MOBILENO varchar(25),
	ARD_FLAG_DP varchar(10),
	ARM_EXCESS_AMT double,
	ARD_STATUS varchar(30),
	ARD_CLS_ST varchar(30),
	ARM_SALESMAN_ID varchar(20),
	ARM_SALESMAN_NAME varchar(80),
	POS_NAME_THA varchar(80),
	EMP_PHONE_NO varchar(30),
	EMP_MOBILE_NO varchar(30),
	ARM_COLLECTOR_ID varchar(20),
	ARM_PAID_CURR_AMT double ,
	ARM_DISCOUNT_AMT double ,
	ARM_ORG_AGING_TYPE varchar(30),
	ARM_ORG_AGING_CURR_TYPE varchar(30),
	ARM_ORG_MNT_ARREAR long,
	ARM_ORG_ARREAR_AMT double,
	ARM_ORG_EXCESS_AMT double,
	ARM_INTEREST_RATE double,
	ARM_PRINCIPLE_AMT double,
	ARM_ACTUAL_BANKDATE datetime,
	SHOULD_PAID_AMT double	);

คำสั่ง vba ถูกเขียน บน personal workbook เพื่อที่จะโหลดไฟล์นี้ ได้ทุกเดือน
****ใช้เวลารันนานมากกว่า 15 นาที****

Code: Select all

Sub Upload_AR_BAL()
    Dim counting As Date
    counting = Now()
    On Error GoTo ErrHandle
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim twb As Workbook
    Dim ConStr As String
    Dim pntr As Range
    Set twb = ActiveWorkbook
    
    ConStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\YourPath\DB_MASTERFILE.accdb; Persist Security Info=False;"
    Set cn = New ADODB.Connection
    cn.Open ConStr
    Set rs = New ADODB.Recordset
    sql = " SELECT P.AR_NO, P.ref1, P.AREA_CODE, P.REG_CODE, P.DEP_CODE, P.DEP_NAME_THA, P.PRD_MD_CODE, P.MPM_NAMETHI, P.SERIAL_NO, " & _
" P.ARD_SALE_D, P.ARD_CS_PRI, P.ARD_HP_PRI, P.ARD_DW_REQ, P.ARD_MN_TRM, P.ARD_CT_TRM, P.ARD_AMT_FN, P.ARD_HP_COL, P.ARD_CUR_HP, " & _ 
" P.ARD_BAL, P.ARD_MN_DEL, P.ARD_MN_ARR, P.ARD_LS_PYD, P.ARD_CUR_AR, P.CLAIM_FEE, P.LATE_FEE, P.ARM_ACC_STAT, P.ARM_CLOSED_TYPE, " & _ 
" P.ARM_CLOSED_DATE, P.ARM_RED_FLAG, P.CIDCARD, P.CTITLE, P.CFNAME, P.CLNAME, P.CADDRESS1, P.CADDRESS2, P.CADDRESS3, P.ZIP_CODE, " & _ " P.MobileNo1, P.TelephoneNo, P.ExtensionNo, P.ARD_OLD_ACNO, P.ARD_OLD_SH, P.OAREA_CODE, P.OREG_CODE, P.ODEP_NAME_THA, P.C_MOBILENO," & _  " P.ARD_FLAG_DP, P.ARM_EXCESS_AMT, P.ARD_STATUS, P.ARD_CLS_ST, P.ARM_SALESMAN_ID, P.ARM_SALESMAN_NAME, P.POS_NAME_THA, P.EMP_PHONE_NO," & _  " P.EMP_MOBILE_NO, P.ARM_COLLECTOR_ID, P.ARM_PAID_CURR_AMT, P.ARM_DISCOUNT_AMT, P.ARM_ORG_AGING_TYPE, P.ARM_ORG_AGING_CURR_TYPE," & _  " P.ARM_ORG_MNT_ARREAR, P.ARM_ORG_ARREAR_AMT, P.ARM_ORG_EXCESS_AMT, P.ARM_INTEREST_RATE, P.ARM_PRINCIPLE_AMT, P.ARM_ACTUAL_BANKDATE," & _ 
" P.SHOULD_PAID_AMT FROM ar_p AS P;
 WHERE 0 = 1;"
    Dim lastFname As String
    rs.Open sql, cn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    For Each pntr In Range("A2:A" & [A2].Offset.End(xlDown).Row)
        If pntr Is Not Null Then
        With pntr
        rs.AddNew
            
rs(0) = .Value
rs(1)= .offset(1).Value
rs(2)= .offset(2).Value
rs(3)= .offset(3).Value
rs(4)= .offset(4).Value
rs(5)= .offset(5).Value
rs(6)= .offset(6).Value
rs(7)= .offset(7).Value
rs(8)= .offset(8).Value
rs(9)= .offset(9).Value
rs(10)= .offset(10).Value
rs(11)= .offset(11).Value
rs(12)= .offset(12).Value
rs(13)= .offset(13).Value
rs(14)= .offset(14).Value
rs(15)= .offset(15).Value
rs(16)= .offset(16).Value
rs(17)= .offset(17).Value
rs(18)= .offset(18).Value
rs(19)= .offset(19).Value
rs(20)= .offset(20).Value
rs(21)= .offset(21).Value
rs(22)= .offset(22).Value
rs(23)= .offset(23).Value
rs(24)= .offset(24).Value
rs(25)= .offset(25).Value
rs(26)= .offset(26).Value
rs(27)= .offset(27).Value
rs(28)= .offset(28).Value
rs(29)= .offset(29).Value
rs(30)= .offset(30).Value
rs(31)= .offset(31).Value
rs(32)= .offset(32).Value
rs(33)= .offset(33).Value
rs(34)= .offset(34).Value
rs(35)= .offset(35).Value
rs(36)= .offset(36).Value
rs(37)= .offset(37).Value
rs(38)= .offset(38).Value
rs(39)= .offset(39).Value
rs(40)= .offset(40).Value
rs(41)= .offset(41).Value
rs(42)= .offset(42).Value
rs(43)= .offset(43).Value

        Application.StatusBar = pntr
        rs.MoveNext

        End With
        End If
    Next pntr
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
MsgBox DateDiff("s", counting, Now())
Exit Sub
ErrHandle:

    Debug.Print pntr & ":=" & Err.Number & ":="; lastFname
    Resume Next
    
End Sub

ใช้ 4G ประมาณ 69mb ดังนั้นใช้ Internet บ้านจะดีกว่า สาเหตุที่ต้องให้เป็นไฟล์ใหญ่ เพราะ ข้อมูล มันเข้าไม่ครบท้ัง 160,000 records
มันเข้าไปแค่ 61240 records เอง รันกีที่ Network ก็แล้ว Local ก็แล้ว ได้เท่าเดิม
https://drive.google.com/drive/folders/ ... XckNwevKDz

[snasui]

ผมใช้ Code ด้านล่าง โดยใส่ข้อมูลไปเพียง 4 คอลัมน์ ใช้เวลา Run ไป 162 วินาที อ่านตามที่ Message แจ้ง

Code: Select all

Sub Upload_AR_BALz()
    Dim counting As Date
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim twb As Workbook
    Dim ConStr As String
    Dim pntr As Range
    Dim arr As Variant
    Set twb = ActiveWorkbook
    Dim lastFname As String
    
    counting = Now()
    
    ConStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\YourPath\DB_MASTERFILE.accdb; Persist Security Info=False;"
    sql = "INSERT INTO ar_p "
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    
    cn.Open ConStr
    With twb.Worksheets(1)
        For Each pntr In .Range("A2", .Range("a" & .Rows.Count).End(xlUp))
            arr = "VALUES('" & VBA.Join(Application.Transpose( _
                Application.Transpose(pntr.Resize(1, 4).Value)), "','") & "')"
            rs.Open sql & arr, cn
        Next pntr
    End With
'    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
    MsgBox DateDiff("s", counting, Now())

End Sub

สำหรับไฟล์ข้อมูลให้ Save เป็น Binary File คือนามสกุลเป็น .xlsb เพื่อจะได้มีขนาดเล็กเหมาะกับการใช้ในโปรแกรมต่าง ๆ ครับ

[gaka]

แก้ sql ข้างบน ผมก็อปมาผิด

Code: Select all

    sql = " SELECT P.AR_NO, P.ref1, P.AREA_CODE, P.REG_CODE, P.DEP_CODE, P.DEP_NAME_THA, P.PRD_MD_CODE, P.MPM_NAMETHI, P.SERIAL_NO, " & _
            " P.ARD_SALE_D, P.ARD_CS_PRI, P.ARD_HP_PRI, P.ARD_DW_REQ, P.ARD_MN_TRM, P.ARD_CT_TRM, P.ARD_AMT_FN, P.ARD_HP_COL, P.ARD_CUR_HP, " & _
            " P.ARD_BAL, P.ARD_MN_DEL, P.ARD_MN_ARR, P.ARD_LS_PYD, P.ARD_CUR_AR, P.CLAIM_FEE, P.LATE_FEE, P.ARM_ACC_STAT, P.ARM_CLOSED_TYPE, " & _
            " P.ARM_CLOSED_DATE, P.ARM_RED_FLAG, P.CIDCARD, P.CTITLE, P.CFNAME, P.CLNAME, P.CADDRESS1, P.CADDRESS2, P.CADDRESS3, P.ZIP_CODE, " & _
            " P.MobileNo1, P.TelephoneNo, P.ExtensionNo, P.ARD_OLD_ACNO, P.ARD_OLD_SH, P.OAREA_CODE, P.OREG_CODE, P.ODEP_NAME_THA, P.C_MOBILENO," & _
            " P.ARD_FLAG_DP, P.ARM_EXCESS_AMT, P.ARD_STATUS, P.ARD_CLS_ST, P.ARM_SALESMAN_ID, P.ARM_SALESMAN_NAME, P.POS_NAME_THA, P.EMP_PHONE_NO," & _
            " P.EMP_MOBILE_NO, P.ARM_COLLECTOR_ID, P.ARM_PAID_CURR_AMT, P.ARM_DISCOUNT_AMT, P.ARM_ORG_AGING_TYPE, P.ARM_ORG_AGING_CURR_TYPE," & _
            " P.ARM_ORG_MNT_ARREAR, P.ARM_ORG_ARREAR_AMT, P.ARM_ORG_EXCESS_AMT, P.ARM_INTEREST_RATE, P.ARM_PRINCIPLE_AMT, P.ARM_ACTUAL_BANKDATE," & _
            " P.SHOULD_PAID_AMT FROM ar_p AS P WHERE 0 = 1;" 

รบกวนอธิบายโค๊ด

For Each pntr In .Range("A2", .Range("a" & .Rows.Count).End(xlUp))
arr = "VALUES('" & VBA.Join(Application.Transpose( _
Application.Transpose(pntr.Resize(1, 4).Value)), "','") & "')"
rs.Open sql & arr, cn
Next pntr

[snasui]

เป็นการนำข้อมูลในบรรทัด pntr จำนวน 4 คอลัมน์มาใช้เชื่อมก้นด้วย ',' เพื่อให้เป็น SQL Statement ในส่วนของ Value ของ Statement Insert ครับ

[gaka]

อัพเดท
พบที่มาของปัญหาแล้วตัวเดต้ามีขนาดเกินกว่าฟิวส์ที่กำหนดจะเก็บได้จึงทำให้ adodb ปฏิเสธการเก็บเรคคอร์ด Record นั้นหรือฟิวนั้น จากการดูข้อมูลจริงพบว่าเป็น Space ว่างๆที่ถูก insert ต่อท้ายเอาไว้จึงทำการtrim ออก ก็สามารถ insert ได้ครบถ้วน