Nhờ hướng dẫn chỉnh code import từ access sang excel

[heyhey1994]

Chào cả nhà, em có dòng code này chọn file access rồi xuất sang excel mà ko biết sai ở đâu mà nó ko chạy. Cái này em dùng record macro rồi chỉnh sửa lại. Nhờ mọi người giúp đỡ ạ.

Sub TAIDULIEUTINHTOAN()
Dim Filt As String
 Dim FilterIndex As Integer
 Dim Title As String
 Dim Filename As String
 Filt = "Microsoft Access Database(*.mdb),*.mdb," & _
        "All Files (*.*),*.*"
 FilterIndex = 1
 Title = "Load Data"
 Filename = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=FilterIndex, Title:=Title)
 If Filename = "False" Then
 MsgBox "NO FILE."
 Exit Sub
 End If
 
Sheets("Beam Forces").Activate
Sheets("Beam Forces").Columns("A:Z").Select
Selection.ClearContents
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & Filename & ";Mode=Share Deny Write" _
        , _
        ";Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine " _
        , _
        "Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New " _
        , _
        "Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Comp" _
        , _
        "act=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False" _
        ), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Beam Forces")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = Filename
        .Refresh BackgroundQuery:=False
    End With
End sub

 

[ppc0312]

Bai

Chào cả nhà, em có dòng code này chọn file access rồi xuất sang excel mà ko biết sai ở đâu mà nó ko chạy. Cái này em dùng record macro rồi chỉnh sửa lại. Nhờ mọi người giúp đỡ ạ.

Sub TAIDULIEUTINHTOAN()
Dim Filt As String
Dim FilterIndex As Integer
Dim Title As String
Dim Filename As String
Filt = "Microsoft Access Database(*.mdb),*.mdb," & _
        "All Files (*.*),*.*"
FilterIndex = 1
Title = "Load Data"
Filename = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=FilterIndex, Title:=Title)
If Filename = "False" Then
MsgBox "NO FILE."
Exit Sub
End If

Sheets("Beam Forces").Activate
Sheets("Beam Forces").Columns("A:Z").Select
Selection.ClearContents
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & Filename & ";Mode=Share Deny Write" _
        , _
        ";Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine " _
        , _
        "Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New " _
        , _
        "Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Comp" _
        , _
        "act=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False" _
        ), Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Beam Forces")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = Filename
        .Refresh BackgroundQuery:=False
    End With
End sub

Bão lỗi ở đâu,
Để nguyên macro đâu, có chạy thông suốt không?
Nhưng thường người ta dùng ADO để lấy dữ liệu từ Access sang Excel, thử tìm hiểu xem có dễ và gọn hơn không