Question

我试图让这段代码工作，但它似乎不想从getopenfilename命令中提取字符串，所以我想我会看到是否有人对如何重新配置此代码有任何想法，以便它不会将getopenfilename字符串视为文本，而是将其视为真实路径......

Sub DB_Import()
    Dim FilePath As Variant

    MsgBox ("Select the path and filename of the correct database")
    FilePath = Application.GetOpenFilename

    With ActiveSheet.ListObjects.Add(
        SourceType:=0, 
        Source:=Array( _
            "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin; " & _
            "DataSource=FilePath;Mode=Share Deny Write;Extended Properties=""""; " & _
            "Jet OLEDB:System database="""";Jet OLEDB:Registry Path=""""; " & _
            "Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=6;" & _
            "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 Compact=False;Jet OLEDB:Compact Without Replica Repair=False;" & _
            "Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;" & _
            "Jet OLEDB:Bypass UserInfo Validation=False"), 
        Destination:=Range("$A$1")).QueryTable

        .CommandType = xlCmdTable
        .CommandText = Array("Query1")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = FilePath
        .ListObject.DisplayName = "Table_ExternalData_1"

        .Refresh BackgroundQuery:=False
    End With
End Sub

Answer 1

将第二行更改为：

"DataSource=" & FilePath & ";Mode=Share Deny Write;Extended Properties=""""; " & _

这会将FilePath的值插入到您的连接字符串中。

使用VBA将Access查询输出导入Excel

1 个答案: