Vba to import data from Access to Excel

[Shak3]

Hi, im newbie in vba excel...
and im bad in english...

I want to import data from access table into excel with just select the filename and then its done...

before it is succeed to import from txt file with this folowing script :

Sub ImportTextFile()


Application.ScreenUpdating = False
        Sheets("KCU").Select
        Cells.Select
        Selection.Clear
        Range("A1").Select
        
Dim fName As String


fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fName = "False" Then Exit Sub


    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("$A$1"))
            .Name = "010. KCU"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 932
            .TextFileStartRow = 1
            .TextFileParseType = xlFixedWidth
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileFixedColumnWidths = Array(5, 2, 2, 16, 2, 30, 2, 11, 2, 14, 2, 20, 2, 20, 2)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With
    Sheets("Home").Select
Application.ScreenUpdating = True
End Sub

i want to do the same thing when import data from access,
this is the result from recording the macro :

Sub Macro1()
'
' Macro1 Macro
'


'
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=D:\Brankas\Project\Laporan SKIM SEKTOR (edit macro 2018)" _
        , _
        "\LPK ACCESS 2018\LPK ACSES\LPK JUNI 2018.mdb;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 Part" _
        , _
        "ial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Je" _
        , _
        "t OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet O" _
        , "LEDB:SFP=False;Jet OLEDB:Support Complex Data=False"), Destination:=Range( _
        "$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("WD_LPKTXT_STAGING")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "D:\Brankas\Project\Laporan SKIM SEKTOR (edit macro 2018)\LPK ACCESS 2018\LPK ACSES\LPK JUNI 2018.mdb"
        .ListObject.DisplayName = "Table_LPK_JUNI_2018"
        .Refresh BackgroundQuery:=False
    End With
End Sub

Then want to imitate the import text vba, and this is the result :

Application.ScreenUpdating = False
        Sheets("LPK").Select
        Cells.Select
        Selection.Clear
        Range("A1").Select
        
Dim fName As String


fName = Application.GetOpenFilename("Access Databases (*.mdb), *.mdb")
If fName = "False" Then Exit Sub
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=fName" _
        , _
        "fName;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 Part" _
        , _
        "ial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Je" _
        , _
        "t OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet O" _
        , "LEDB:SFP=False;Jet OLEDB:Support Complex Data=False"), Destination:=Range( _
        "$A$1")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("WD_LPKTXT_STAGING")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = _
        "fName"
        .ListObject.DisplayName = "Table_LPK"
        .Refresh BackgroundQuery:=False
    End With
Sheets("Home").Select
Application.ScreenUpdating = True
End Sub

but it wont work, please help me Master...

 

[ranman256]

Use the CONNECTIONS button....build the connection,
connect it to the Access table and the macro will import.