รบกวนขอการเขียนโปรแกรมแบบ ADOนำข้อมูลจากAccessเข้าไปที่Excel

[akekorn]

สวัสดีครับคุณคนควนและเพื่อนสมาชิกทุกท่าน
วันนี้ผมอยากได้ตัวอย่าง coding แบบ ADO ที่นำข้อมูลจาก Access เข้ามาที่ Excel ไม่ทราบว่าควรเขียนอย่างไร
ผมได้แนบฐานข้อมูลตัวอย่างมาให้ด้วย คือต้องการให้ฐานข้อมูลที่มีอยู่ใน Access import ไปที่ Excel ครับโดยให้ข้อมูลเข้าไปอยู่แบบใน file ผลลัพภ์.xls ครับ
รบกวนขอความรู้ด้วยครับ

ขอบคุณครับ
เอกกร

[akekorn]

ฐานข้อมูลครับ

[snasui]

ลองดูตัวอย่างจาก Code จาก Link ด้านล่างนี้และลองเขียนมาก่อน ติดตรงไหนถามมาได้เรื่อย ๆ ครับ

Import data from Access to Excel with ADO

[akekorn]

คุณคนควนกรุณาเขียนให้ดูเป็นตัวอย่างได้ไหมครับผมลองดูแล้วยังงงๆอยู่เลยครับ

[snasui]

คุณ akekorn ควรเขียนมาก่อนครับ สำหรับ VBA แล้ว สมาชิกจำเป็นต้องเขียนมาก่อนเสมอแล้วถามกันเฉพาะที่ติดปัญหาเท่านั้นครับ

[akekorn]

คุณคนควนครับผมลองเขียนแล้วแต่มันยังติดที่ไม่ทราบว่าจะใส่ filed เข้าไปยังไงแล้วพอ run ลงมาก็มีติด error รบกวนช่วยดูให้หน่อยนะครับ

ขอบคุณครับ

[snasui]

ลองปรับ Code เป็นตามด้านล่างและเปลี่ยน D:\data.mdb เป็นตำแหน่งจริงที่วางไฟล์

Code: Select all

Sub importfile()
    Dim conn As ADODB.Connection
    Set rs = New ADODB.Recordset
    Dim sql As String, sFile As String
    sFile = "D:\data.mdb"
    sql = "select * from txt"    
    sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & sFile & ";" & _
    "Persist Security Info=False"    
'    If rs.State = 1 Then rs.Close    
    rs.Open sql, sConStr
    With Sheets("Sheet1")
        .Range("A1").CurrentRegion.Offset(1, 0).Clear
        .Range("A2").CopyFromRecordset rs
    End With
'    Do While Not rs.EOF
'    rs.MoveNext
'    Loop
    Set conn = Nothing
    Set rs = Nothing
End Sub

[akekorn]

ขอโทษที่เข้ามาช้าครับขอบคุณคุณคนควนมากๆนะครับ

[akekorn]

คุณคนควนครับผมรบกวนอีกข้อได้ไหมครับคือจากตัวอย่างที่คุณคนควนได้ให้มาจะนำเฉพาะข้อมูลมาให้แต่หากผมอยากให้ fieldname ของฐานข้อมูลมาด้วยจะต้องเพิ่ม code อย่างไรครับ

ขอบคุณครับ

[snasui]

สามารถดูตัวอย่างการนำ Field มาแสดงได้จาก Link นี้ครับ http://support.microsoft.com/kb/246335

[akekorn]

คุณคนควนครับผมลองดูแล้วแต่ไม่รู้จะแทรกไว้ตรงไหนดีครับ จากโค๊ด

Code: Select all

Sub importfile()
    
Dim I As Integer
    
    Dim conn As ADODB.Connection
    Set rs = New ADODB.Recordset
    Dim sql As String, sFile As String
    Application.ScreenUpdating = False
    
    sFile = Range("path01").Value
    sql = "select * from ccap_booked_daily"
    sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & sFile & ";" & _
    "Persist Security Info=False"
 
    Sheets("ccap_booked_daily").Select
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select

    rs.Open sql, sConStr
    With Sheets("ccap_booked_daily")
        .Range("A1").CurrentRegion.Offset(1, 0).Clear
        .Range("A2").CopyFromRecordset rs
    End With
'    Do While Not rs.EOF
'    rs.MoveNext
'    Loop
    Set conn = Nothing
    Set rs = Nothing
    Call akekorn
    MsgBox "Programe Complete"
End Sub

[akekorn]

ผมลองได้เพิ่มโค๊ดตัวนี้เข้าไปแต่โปรแกรมตายครับคุณคนควนรบกวนช่วยดูให้หน่อยครับ

Code: Select all

Sub importfile()
    
Dim I As Integer
    
    Dim conn As ADODB.Connection
    Set rs = New ADODB.Recordset
    Dim sql As String, sFile As String
    Application.ScreenUpdating = False
    
    sFile = Range("path01").Value
    sql = "select * from ccap_booked_daily"
    sConStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & sFile & ";" & _
    "Persist Security Info=False"
 
    Sheets("ccap_booked_daily").Select
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select
'*****************
I = ActiveCell.Row
Do While Not rs.EOF
For J = 0 To rs.Fields.Count - 1
Cells(I, J + 1).Value = rs.Fields(J)
Next J
rs.MoveNext
I = I + 1
Loop


'********************

    rs.Open sql, sConStr
    With Sheets("ccap_booked_daily")
        .Range("A1").CurrentRegion.Offset(1, 0).Clear
        .Range("A2").CopyFromRecordset rs
    End With
'    Do While Not rs.EOF
'    rs.MoveNext
'    Loop
    Set conn = Nothing
    Set rs = Nothing
    Call akekorn
    MsgBox "Programe Complete"
End Sub

[snasui]

ลองปรับ Code ตามด้านล่างดูครับ

Code: Select all

Sub importfile()
    Dim conn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim sConstr As String
    Dim FieldRange As Range
    Dim fld As Field, i As Integer
    Dim sql As String, sFile As String
    Sheets("Sheet1").Range("A1").CurrentRegion.Clear
    sFile = "E:\data.mdb"
    sql = "select * from txt"
    sConstr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & sFile & ";" & _
    "Persist Security Info=False"
    conn.Open sConstr
    With Sheets("Sheet1")
        Set FieldRange = .Range("A1")
        rs.Open sql, conn
        For Each fld In rs.Fields
            FieldRange.Offset(0, i).Value = fld.Name
            i = i + 1
        Next fld
        .Range("A2").CopyFromRecordset rs
    End With
    Set conn = Nothing
    Set rs = Nothing
End Sub

[akekorn]

ทำได้แล้วครับขอบคุณมากๆครับผม