如何将超过65536行从excel传输到Access - 版本2010

时间:2014-02-11 11:25:09

标签: vba ms-access excel-vba import access-vba

我有以下代码将一些行从Excel传输到Access数据库,然后从Access导出到.txt文件。问题是当我将它导出到Access时,它只导出65536行。有办法解决吗?

 Sub Mailing_Recebido()
    Dim i As Long
    Dim Caminho As String
    Dim A As Object

    Range("i27").Value = "Inicio da Exportação..."

    Range("BJ18").Select
    ActiveCell.FormulaR1C1 = "=CELL(""nome.arquivo"")"
    Range("BJ18").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("BJ18"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="[", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    Range("BK18").Select
    Selection.ClearContents
    Caminho = Range("bj18").Value

    Sheets("Mailing_Recebido").Select

    Range("a5").Select
    i = Cells(Rows.Count, 1).End(xlUp).Row

    Sheets("Plan1").Select
    Range("BO5").Value = i

    Range("BO3").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(Mailing_Recebido!R[2]C[-66]:R[1048573]C[-66])"

    ActiveSheet.Calculate

    'Range("BN3").Select
    Range("BM26").Select
    Range("BM26").Value = Range("BO8").Value

    Set A = CreateObject("Access.Application")
    A.Visible = False
    A.OpenCurrentDatabase (Caminho + "\Cria_Mailing.mdb")
    A.DoCmd.RunMacro "Executar"

    'Range("bk22").Value = FileLen(Caminho + "\" + Range("c32").Value)
    Calculate

    'Call XTo_txt
    Range("i27").Value = "Exportação Completada..."
 End Sub

函数“Exportar”调用2个新函数“Importar”,然后在这里调用“Exportar”:

Option Compare Database
Function exporta()

    Dim rs As DAO.Recordset
    Dim caminho As String
    Dim NomeArq As String

    Set db = CurrentDb()
    Set rs = db.OpenRecordset("NOMEBASE")


    caminho = rs.Fields(0).Value + "\" + rs.Fields(1).Value

    DoCmd.TransferText acExportFixed, "Mailing_Envio", "BASE", caminho

End Function


Function importa()

    Dim rs As DAO.Recordset
    Dim inicio As String
    Dim fim As String

'DoCmd.TransferSpreadsheet acImport, , _
    '"NOMEBASE", Application.CurrentProject.Path() + "\Abre_Envio_Novo_Layout.xlsm", True, "Plan1!BJ25:BM26"

 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
    "NOMEBASE", Application.CurrentProject.Path() + "\Abre_Envio_Novo_Layout.xlsm", True, "Plan1!BJ25:BM26"

    Set db = CurrentDb()
    Set rs = db.OpenRecordset("NOMEBASE")

    inicio = rs.Fields(2).Value
    fim = rs.Fields(3).Value


'DoCmd.TransferSpreadsheet acImport, , _
    '"BASE", Application.CurrentProject.Path() + "\Abre_Envio_Novo_Layout.xlsm", True, "Mailing_Recebido!A:AX"
    ' + inicio + ":" + fim

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
    "BASE", Application.CurrentProject.Path() + "\Abre_Envio_Novo_Layout.xlsm", True, "Mailing_Recebido!A:AX"
    ' + inicio + ":" + fim


    rs.Close

End Function

1 个答案:

答案 0 :(得分:0)

首先,你应该使用OPTION EXPLICIT。

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12xml

这将告诉Access导出尽可能多的记录

相关问题