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