MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Conexão Excel

    Compartilhe

    kendy
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1
    Registrado : 23/10/2013

    Conexão Excel

    Mensagem  kendy em Qua 23 Out 2013, 20:44

    Boa tarde,

    Senhores, preciso importar uma tabela do excel para um banco do Access, estou usando a seguinte rotina


    Private Sub Comando0_Click()

    Dim xlApp As Excel.Application
    Dim xlBk As Excel.Workbook
    Dim xlSht As Excel.Worksheet

    Dim dbRst As Recordset
    Dim dbs As Database
    Dim SQLStr As String
    Dim sSQL As String

    Set dbs = CurrentDb
    Set xlApp = Excel.Application
    Set xlBk = xlApp.Workbooks.Open("C:\Users\Eduardo Yamasaki\Desktop\test\plan.xlsx")
    Set xlSht = xlBk.Sheets(1)

    SQLStr = "DROP TABLE excelData"
    DoCmd.SetWarnings False
    DoCmd.RunSQL (SQLStr)


    SQLStr = "CREATE TABLE excelData(columnOne TEXT, columnTwo TEXT)"
    DoCmd.SetWarnings False
    DoCmd.RunSQL (SQLStr)

    Set dbRst = dbs.OpenRecordset("excelData")
    dbRst.AddNew


    sSQL = "SELECT * INTO [excelData] " & "IN '" & "C:\Users\Eduardo Yamasaki\Desktop\test\plan.xlsx" & "' " & " FROM [Plan1$]"
    DoCmd.RunSQL (sSQL)



    dbRst.Close
    dbs.Close

    End Sub

    Quando ele vai executar o select, ele não consegue encontrar a planilha Plan1

    Obrigado,

    At,

    Eloirp
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 149
    Registrado : 15/06/2013

    Re: Conexão Excel

    Mensagem  Eloirp em Qui 07 Nov 2013, 10:22

    Olá Amigo,

    Eu consegui com um modelo do próprio fórum e fiz alguns pequenos ajustes para minha necessidade e ficou assim:

    1 - Primeiro eu localizo o caminho e arquivo excel e coloco no campo OrigemPath o caminho e no campo Arquivo o nome do arquivo:

    Private Sub bt_Abrir_Click()

       ' Aqui seleciono o caminho e arquivo a ser importado
       Dim fd As Object
       Dim X As String
       
       Set fd = Application.FileDialog(1)
       
       With fd
           .ButtonName = "Abrir"
           .Title = "Selecione o local onde se encontra o arquivo..."
           
           If .Show Then
               Selecionarpasta = .SelectedItems(1)
               X = Selecionarpasta
           End If
       End With
       
       Set fd = Nothing

       Dim strFullFilePath As String
       strFullFilePath = Selecionarpasta

       Dim Fso
       Set Fso = CreateObject("Scripting.FileSystemObject")
       Me.OrigemPath = Fso.GetParentFolderName(strFullFilePath) ' aqui fica o caminho
       Me.Arquivo = SeparaNomes(X, "\", 3) ' aqui fica o nome do arquivo
       
    End Sub


    2 - Depois faço a importação para a tabela:
    Private Sub bt_ImportaExcel_Click()
       
       ' Aqui faz a importação do Excel para a tabela
       Dim strPathFile As String, strFile As String, strPath As String
       Dim blnHasFieldNames As Boolean
       Dim intWorksheets As Integer
       Dim strWorksheets(1 To 1) As String
       
       Dim strTables(1 To 1) As String
       
       strWorksheets(1) = "Plan1" ' Nome da planilha onde buscar os dados no arquivo excel
       strTables(1) = "tbl_MinhaTabela" ' Nome da tabela que irá receber os dados
       blnHasFieldNames = True
       strPath = "" & Me.OrigemPath & "\"
       
       For intWorksheets = 1 To 1
       
       strFile = Dir(strPath & "" & Me.Arquivo & "")
       
       Do While Len(strFile) > 0
       strPathFile = strPath & strFile
       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTables(intWorksheets), strPathFile, blnHasFieldNames, strWorksheets(intWorksheets) & "$"
       strFile = Dir()
       Loop

       Next intWorksheets

    End Sub


    No meu caso funcionou bem tranquilo....

      Data/hora atual: Sex 09 Dez 2016, 03:51