将MS Access数据作为现有数据下方的新行插入Excel

时间:2012-08-17 01:38:52

标签: excel vba ms-access excel-vba

我需要将MS Access表中的行导入Excel。下面的VBA宏就是这样做的。

Sub Macro1()
'
'
    With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
        "ODBC;DSN=MS Access Database;DBQ=C:\Documents and Settings\Administrator\My Documents\test_db.mdb;DefaultDir=C:\Documents and Setting" _
        ), Array( _
        "s\Administrator\My Documents;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
        )), Destination:=Range("A1"))
        .CommandText = Array( _
        "SELECT Table1.ID, Table1.name, Table1.id, Table1.var1, Table1.var2" & Chr(13) & "" & Chr(10) & "FROM `C:\Documents and Settings\Administrator\My Documents\test_db`.Table1 Table1" _
        )
        .Name = "Query from MS Access Database"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertEntireRows
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

MS Access table1

name    id    var1    var2
joe     1     23      34

当我运行宏一次时,我进入Excel

name    id    var1    var2
joe     1     23      34

当我再次运行宏时,我进入Excel

name    id    var1    var2    name    id    var1    var2
joe     1     23      34      joe     1     23      34

而不是

name    id    var1    var2
joe     1     23      34
name    id    var1    var2
joe     1     23      34

您是否知道我应该更改哪些内容以便将MS Access行导入Excel作为现有数据下的新数据行?

2 个答案:

答案 0 :(得分:1)

更改

)), Destination:=Range("A1"))
说些不同的话。也许

)), Destination:= Range("A65536").End(xlUp).offset(1,0)

根据您导入数据的方式,您可能需要做的不仅仅是这些。

答案 1 :(得分:0)

Enderland的回答对我来说很有用,我在一个查询表中将一个月的文本文件导入excel并将它们附加到彼此的末尾。部分代码如下所示。目标工作簿的第二个工作表中包含dates =文件名。我现在意识到我可以向用户询问月份和年份,并生成带有循环的文件名。除了六月,四月,九月,十一月= 30& 2月= 28/29。我会那样做的。

Dim sDate As String Dim sDataPath As String Dim i As Integer Dim mMax As Integer Dim Label_F_Name As String Dim F_name As String

sDataPath =工作表(“D& L”)。单元格(1,“G”)。值'位于第二张工作簿中 mMax =工作表(“D& L”)。单元格(1,“D”)。位于第二张工作簿中的值'值

对于i = 1至mMax     sDate =“A_”+ CStr(工作表(“D& L”)。单元格(1 + i,“A”)。值)+“。csv”'循环遍历工作表中的日期列表

'使用文件名标记数据列,以便可以验证数据是否来自正确的文件     Label_F_Name = sDate +“.........................”     F_name = sDataPath + sDate     范围(“'D& L'!D5”)= F_name

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + F_name, Destination:=Range("H1048576").End(xlUp).Offset(4, 0)) ' offset for existing header
    .Name = Label_F_Name
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertEntireRows ' appends data to end of previous
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = False
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileCommaDelimiter = True
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

接下来我