Как импортировать файл Excel в Microsoft Access 2013 - PullRequest
Новая
       15

Как импортировать файл Excel в Microsoft Access 2013

0 голосов
/ 22 февраля 2019

У меня есть база данных Access 2013 со всеми таблицами, связанными с таблицами SQL Server 2016.У меня есть файл Excel 2013 (.xlsx), который мне нужно импортировать в таблицу в Ms Access, которая связана с SQL Server через код vba (все поля в xlsx и таблице совпадают)

Все моиКод VBA находится в базе данных Access, у меня есть форма с кнопкой с событием в нем, я пытаюсь использовать де "Transferpreadsheet", предложение "Вставить в" для SQL, но ни один из них не работал для меня

Вот мой код,

xtRuta2 имя поля в форме, имеющей путь Dim strArchivo2 String 'путь к файлу xlsx c: \ reports \ mireporte.xlsx dim miAlerta2 в виде строки Dim ssql As String

strArchivo2 = txtRuta2

miAlerta2 = MsgBox ("¿Хотите импортировать новую информацию для" & strArchivo2 & "?" & VbCrLf & vbCrLf & "Эта операция будет обновлять всю информацию", vbExclamation + vbOKCancel, «ПРЕДУПРЕЖДЕНИЕ ОБ ИМПОРТЕ ИНФОРМАЦИИ!»)

Если miAlerta2 = vbOK, то varAlert2 = MsgBox («Пожалуйста, подтвердите, что хотите импортировать новую информацию?», vbExclamation + vbOKCancel,«¡ПОДТВЕРЖДЕНИЕ ИМПОРТА ПОДТВЕРЖДЕНИЯ!») Если varAlert2 = vbOK, то 

      'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_ZSales_Export Worksheet", strArchivo2, True, "Export Worksheet$"

            ssql = "INSERT INTO [tbl_Export Worksheet] select * FROM OPENROWSET('Microsoft.ACE.OLEDB.12.0', 'Excel 12.0;Database=" & strArchivo2 & ";HDR=YES', 'SELECT * FROM [Export Worksheet$)'"

            'CurrentDb.Execute ssql

    MsgBox "Import Finished", vbExclamation + vbOKOnly

endif end, если

Можете ли вы помочь мне написать правильный код, чтобы это работало

С уважением!

Ответы [ 2 ]

0 голосов
/ 22 февраля 2019

Этот фрагмент кода (позднее взаимодействие bdingin с Excel) используется для преобразования листа Excel в текстовый файл и последующего импорта в таблицу по вашему выбору.Я предпочитаю использовать этот метод, так как доступ имеет раздражающую привычку пытаться не интерпретировать ваши данные для вас при использовании таблицы трансферов.Создав спецификацию импорта (которую необходимо сделать, чтобы использовать этот метод), вы можете легко предопределить типы данных.

Option Compare Database
Option Explicit

Private Sub stuff()
    On Error GoTo GetAccrualFile_Err
    Dim fileLoc As String
    Dim path As String, Sep As String, NewTextFile As String, WholeLine As String
    Dim oXL As Object, sheet As Object
    Dim i As Long, j As Long, counteri As Long, counterj As Long
    Dim bringOver As Variant
    DoCmd.SetWarnings False
    DoCmd.Hourglass True
    counteri = 0
    counterj = 0
    Sep ="your prefered delimiter"
    DoCmd.RunSQL "DELETE * FROM TBL"
    fileLoc = "UNC PATH AND FILE NAME" & ".xlsx"
    path = Left(fileLoc, InStrRev(fileLoc, "\") - 1) & "\"
    NewTextFile = "UNC PATH AND FILE NAME" & ".txt"
    Set oXL = CreateObject("Excel.Application")
    With oXL
        .WorkBooks.Open FileName:=path & Dir$(fileLoc)
        Open NewTextFile For Output As #2
        bringOver = .Worksheets("your sheet name").UsedRange  'you might need to adjust this line to get the sheet your after
        For i = LBound(bringOver, 1) To UBound(bringOver, 1)
            For j = LBound(bringOver, 2) To UBound(bringOver, 2)
                WholeLine = WholeLine & bringOver(i, j) & Sep
                counterj = counterj + 1
            Next j
            'used if you want to skip column headers
            If counteri <> 0 Then
                Print #2, WholeLine
            End If
            WholeLine = ""
            counteri = counteri + 1
            counterj = 0
        Next i
        counteri = 0
        Erase bringOver
    End With    
    Close #2
    DoCmd.TransferText acImportDelim, "importspecname", "tbltoimportto", NewTextFile, False
    '***************************************************************************************
    'you will need to learn how to set up import specs, as well as understand the arguments for DoCmd.TransferText  
    '***************************************************************************************
CleanUp:
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    On Error Resume Next
    DoEvents
    oXL.Quit
    oXL.Application.Quit
    If Dir(NewTextFile) <> "" Then Kill NewTextFile
    Erase bringOver
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    Exit Sub
GetAccrualFile_Err:
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    msgbox "An error has occured.  " & " " & ERR.Number & " " & ERR.Description & " "
    GoTo CleanUp
    Resume
End Sub
0 голосов
/ 22 февраля 2019

Попробуйте EPPlus, бесплатную библиотеку, которая позволяет вам управлять файлами Excel с платформы .Net.Здесь у вас есть учебник: https://riptutorial.com/epplus

...