2014-02-11 84 views
-2

我有以下代碼將一些行從Excel傳輸到Access數據庫,然後將其從Access導出到.txt文件。問題是,當我將它導出到Access時,它僅導出65536行。有沒有辦法解決它?如何將超過65536行從excel傳輸到Access - 版本2010

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 
+3

出口如果你沒有得到滿意的答覆,以現有問題,請不要隨便重新發布了同樣的問題。相反,[編輯](http://stackoverflow.com/posts/21633155/edit)現有的問題來改進它,並將其「激活」在活動列表中。 –

回答

0

首先,你應該使用OPTION EXLICIT的。

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12xml 

這會告訴獲取儘可能多的記錄,因爲你需要

相關問題