[Resolvido]Importar Excel para e campo extra

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

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

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ç

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