Export Data from Access to Excel

[syquyen1987]

Dear các Anh,

Em có một việc nhờ các anh giúp đỡ ạ. Trên Access có chức năng External Data tới Excel chỉ chưa đầy 1 giây là xong, em muốn xin code VBA đó được không ạ (như hình ảnh ạ). Em có thể viết Code VBA export data tới Excel bằng vòng lặp, nhưng dữ liệu nhiều thì chạy rất lâu ạ. Mong các anh giúp đỡ với ạ. Em cảm ơn các anh ạ

 

[ptm0412]

Thử câu lệnh
DoCmd.OutputTo acOutputTable, "ODDetail", acFormatXLSX, "D:\ODDetail.xlsx", True

 

[syquyen1987]

Thử câu lệnh
DoCmd.OutputTo acOutputTable, "ODDetail", acFormatXLSX, "D:\ODDetail.xlsx", True

Code chạy ngon ạ, em cảm ơn nhiều ạ

 

[syquyen1987]

Thử câu lệnh
DoCmd.OutputTo acOutputTable, "ODDetail", acFormatXLSX, "D:\ODDetail.xlsx", True

Em chào anh ạ, anh có thể cho em hỏi là em muốn cập nhật dữ liệu từ file Excel tới bảng dữ liệu Access thì có được không ạ. Em viết code chạy bị lỗi ạ.
Code của em như sau:

Sub CapNhatData()
Dim cn As Object
Dim rs As Object

Application.ScreenUpdating = False

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Provider = "Microsoft.ACE.OLEDB.12.0"
'cn.Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=0"

cn.Open "E:\METALLURGY JOB REGRISTRATION V2.accdb"
  
rs.Open "SELECT * FROM [TblCOC]", cn
rs.movefirst

i = 2
For i = 2 To 67
    If rs.Fields("COCID") <> Cells(i, 2).Value Then
        rs.movenext
    Else
        With rs
            .Fields("Ni") = Cells(i, 10).Value
            .Fields("Cu") = Cells(i, 11).Value
            .Fields("Fe") = Cells(i, 12).Value
            .Fields("Mg") = Cells(i, 13).Value
            .Fields("MgO") = Cells(i, 14).Value
            .Fields("S") = Cells(i, 15).Value
            .Fields("Co") = Cells(i, 16).Value
            .movenext
        End With
    End If
Next
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub

Em đã làm được rồi ạ

Sub UpdateDb()

'Creating Variable for db connection
Dim sSQL As String
Dim cn As Object
Dim rs As Object


Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=E:\METALLURGY JOB REGRISTRATION V2.accdb;"

Dim a, PID

'a is the row counter, as it seems your data rows start from 2 I have set it to 2
a = 2

'Define variable for the values from Column B to R. You can always add the direct ceel reference to the SQL also but it will be messy.
'I have used only one filed as UserName and so one variable in column B, you need to keep adding to below and them to the SQL query for othe variables
Dim NewUserName


'########Strating to read through all the records untill you reach a empty column.
While VBA.Trim(Sheet1.Cells(a, 5)) <> "" ' It's always good to refer to a sheet by it's sheet number, bcos you have the fleibility of changing the display name later.
'Above I have used VBA.Trim to ignore if there are any cells with spaces involved. Also used VBA pre so that code will be supported in many versions of Excel.

        'Assigning the ID to a variable to be used in future queries
        PID = VBA.Trim(Sheet1.Cells(a, 5))

       'SQL to obtain data relevatn to given ID on the column. I have cnsidered this ID as a text
        sSQL = "SELECT SampleName FROM TblCOC WHERE SampleName='" & PID & "';"
        
        'Set rs = New ADODB.Recordset
        rs.Open sSQL, cn

          If rs.EOF Then

                'If the record set is empty
                'Updating the sheet with the status
                Sheet1.Cells(a, 24) = "ID NOT FOUND"
                'Here if you want to add the missing ID that also can be done by adding the query and executing it.

            Else

                  'If the record found
                  NewUserName = VBA.Trim(Sheet1.Cells(a, 10))
                  sSQL = "UPDATE TblCOC SET Ni ='" & NewUserName & "' WHERE SampleName='" & PID & "';"
                  cn.Execute (sSQL)
                  
                  NewUserName = VBA.Trim(Sheet1.Cells(a, 11))
                  sSQL = "UPDATE TblCOC SET Cu ='" & NewUserName & "' WHERE SampleName='" & PID & "';"
                  cn.Execute (sSQL)
                  
                  NewUserName = VBA.Trim(Sheet1.Cells(a, 12))
                  sSQL = "UPDATE TblCOC SET Fe ='" & NewUserName & "' WHERE SampleName='" & PID & "';"
                  cn.Execute (sSQL)

                  'Updating the sheet with the status
                  Sheet1.Cells(a, 24) = "Updated"

          End If

       'Add one to move to the next row of the excel sheet
       a = a + 1
       rs.Close

 Wend

cn.Close
Set cn = Nothing

End Sub