MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Importar Excel para e campo extra

    Compartilhe

    alexsandroalmeida
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 16/04/2011

    [Resolvido]Importar Excel para e campo extra

    Mensagem  alexsandroalmeida em Dom 09 Jul 2017, 21:59

    Pessoal, estou efetuando a importação de uma planilha Excel utilizando um range de "A1:H500" para o Access via VBA.
    A importação esta ocorrendo corretamente, porém necessito incluir no Access, na próxima coluna(9) um informação fixa, exemplo "DQ_052017".

    Tenho cerca de 5 planilha sendo incluídas e preciso informar a origem de cada uma delas. Pensei que era só incluir um "&" após o "!A1:H500" do código abaixo, porém não é assim...

    Abaixo funcionando corretamente:
    With aaa
    For Each bbb In .Worksheets
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTabela, pathplandados, True, bbb.Name & "!A1:H500"
    Next
    End With


    muito obrigado,
    Alex
    avatar
    ronaldojr1
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 292
    Registrado : 01/08/2011

    Re: [Resolvido]Importar Excel para e campo extra

    Mensagem  ronaldojr1 em Qui 13 Jul 2017, 19:00

    boa tarde

    eu nao manjo de importação e por isso criei um jeitinho brasileiro para fazer o que o nosso amigo do forum perguntou, se alguem souber uma forma mais simples, por favor
    compartilhe com nos!!!.

    vamos ao que interessa. rsrs

    criei duas funções. uma para importação e outra que cria a coluna 'origem' na tabela de importação.
    o codigo ira criar uma tabela. o nome da tabela sera o mesmo nome da planiha do excel, ai com os
    dados acho q vc ja consegue se virar ne. rsrs

    para usar apenas chame a função importPlanilhaExcel("caminho completo do arquivo do excel")

    codigo:
    Código:

    Public Function importPlanilhaExcel(path As String)
    Dim aaa As Excel.Workbook
    Dim bbb As Excel.Worksheet
    Dim xl As Excel.Application
    Dim strTabela As String
    Dim strExcel As String


    strTabela = Mid(path, InStrRev(path, "\"))
    strTabela = Mid(strTabela, 2, (Len(strTabela) - Len(Mid(strTabela, InStrRev(strTabela, "."))) - 1))

    strExcel = path

    Set xl = New Excel.Application
    Set aaa = xl.Workbooks.Open(strExcel) 'nome do seu excel e seu diretorio

    xl.Calculation = xlCalculationManual
    ActiveWorkbook.PrecisionAsDisplayed = False
    xl.ErrorCheckingOptions.BackgroundChecking = False
    With aaa
    For Each bbb In .Worksheets
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTabela, strExcel, True, bbb.Name & "!A1:AQ500"
    Next
    End With
    'cria a coluna origem
    addColumn (path)

    'se quiser registrar apenas o nome do arquivo troque path por strTabela
    'insere a origem dos dados na coluna origem da tabela recem criada
    DoCmd.RunSQL "UPDATE " & strTabela & " set origem='" & path & "'"

    xl.Calculation = xlCalculationAutomatic
    ActiveWorkbook.PrecisionAsDisplayed = True
    xl.ErrorCheckingOptions.BackgroundChecking = True
    aaa.Close False
    End Function

    Function addColumn(path As String) As Boolean
    'By JPaulo ® Maximo Access 2010
    'Modificado por ronaldo

    Dim obj As AccessObject
    Dim dbs As Object
    Dim T As DAO.TableDef
    Dim tblNome, nomeObj As String
    Dim i, j As Integer
    Dim X As Integer
    Dim db As DAO.Database
    Dim isExist As Boolean
      
      
        Set db = CurrentDb() 'para o access 2007
        Set dbs = Application.CurrentProject 'para o access 2000 e 2003
        isExist = False
        
        nomeObj = Mid(path, InStrRev(path, "\"))
        nomeObj = Mid(nomeObj, 2, (Len(nomeObj) - Len(Mid(nomeObj, InStrRev(nomeObj, "."))) - 1))
            
    '       percorre as tabelas
            For i = 0 To db.TableDefs.Count - 1
                Set T = db.TableDefs(i)
                
                tblNome = T.Name
                
                    If Not tblNome Like "Msys*" And tblNome = nomeObj Then
                       'loop para percorrer colunas
                    
                       For j = 0 To db.TableDefs(i).Fields.Count - 1
                           'verifica se coluna origem existe                      
                           If db.TableDefs(i).Fields(j).Name = "origem" Then
                                isExist = True
                           End If
                       Next j
                    End If
                    
                    X = X + 1
            Next i
            
            'se a coluna nao exisitr criar a mesma
            If Not isExist Then
                DoCmd.RunSQL "Alter table " & nomeObj & " add column origem text"
            End If
     
    Set db = Nothing
    Set dbs = Nothing
    End Function

    alexsandroalmeida
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 16/04/2011

    Excelente!!!

    Mensagem  alexsandroalmeida em Sab 15 Jul 2017, 22:42

    Boa Noite Ronaldojr1!

    Muitíssimo obrigado pela ajuda! Com jeitinho brasileiro ou não você me ajudou bastante. Aqui pode ...kkkk

    muito obrigado novamente..
    abç
    avatar
    ronaldojr1
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 292
    Registrado : 01/08/2011

    Re: [Resolvido]Importar Excel para e campo extra

    Mensagem  ronaldojr1 em Seg 17 Jul 2017, 12:59

    disponha, foi um prazer ajudar e o forum agradece o retorno.
    e nao esqueça de marcar o topico como resolvido.

      Data/hora atual: Qui 21 Set 2017, 02:36