Importar Dados Do Excel Para o Access - DAO

Olá pessoal,

Estou eu novamente com essa parte de automação de Access x Excel.

estou com dúvida de como terminar esse código:

Trata-se de um arquivo do Excel com várias planilhas
e não sei quantos registros tem em cada planilha
e também não sei quantas planilhas pode-se ter, isso depende da
movimentação mensal, essa importação irei fazer uma vez por mês
preciso desses dados dentro do access. Como são várias planilhas
com a mesma posição de colunas mas separadas em planilhas
com +/- 16.384 linhas cada planilha e +/- 14 planilhas.
Tenho de juntar tudo e colocar em uma tabela só.
Eu até poderia copiar e colar, mas gostaria de um processo automático.

O código abaixo está comentado, se alguém puder me ajudar
ficarei agradecido.

Código:


        'Abre a tabela para receber os dados
        Set RsTable2 = CurrentDb.OpenRecordset("Tbl_Base2_tmp", dbOpenDynaset)
        'Faz o loop nas planilhas
        For I = 1 To cmbSheet
            Registros1 = RsTable2.RecordCount
            'Define qual será a planilha
            xcel.Sheets("Sheet" & I).Select
            'Faz o loop nos registros do excel
            L = 1
            strvalor = SysCmd(acSysCmdInitMeter, "Importando planilha " & I & "...", Registros1)
            LOOP NO EXCEL
                strvalor = SysCmd(acSysCmdUpdateMeter, contador)
                RsTable2.AddNew
                    RsTable2("CRIADAMANUAL") = xcel.Cells(L, 1).Value
                    RsTable2("NUMDOC") = xcel.Cells(L, 2).Value
                    RsTable2("NUMNF") = xcel.Cells(L, 3).Value
                    RsTable2("DTLANC") = xcel.Cells(L, 4).Value
                    RsTable2("DTEMISSAO") = xcel.Cells(L, 5).Value
                    RsTable2("CENTRO") = xcel.Cells(L, 6).Value
                    RsTable2("NUMDOCU") = xcel.Cells(L, 7).Value
                    RsTable2("NUMITEMDOC") = xcel.Cells(L, 8).Value
                    RsTable2("CRIARDT") = xcel.Cells(L, 9).Value
                    RsTable2("CATEGORIA") = xcel.Cells(L, 10).Value
                    RsTable2("MATRICULA") = xcel.Cells(L, 11).Value
                    RsTable2("LOCALNEGOCIO") = xcel.Cells(L, 12).Value
                RsTable2.Update
            Wend
            strvalor = SysCmd(acSysCmdClearStatus)
        Next I
        'Fecha a tabela
        Set RsTable2 = Nothing
    End If
    'Fecha o arquivo do Excel
    xcel.ActiveWorkbook.Close True
    xcel.Quit
    Set xcel = Nothing


Não estou sabendo como faço o loop no excel e quantos registros tem em cada planilha.
cmbsheet é onde eu informo o numero de planilhas
é do tipo integer. cmbsheet não é uma variável, é uma combox
e nela eu informo de 1 a 20 o numero de planilhas
o for next irá rodar de acordo com esse número.
é isso.

Ola Sames, seja bem vindo ao fórum.

Amigão é apenas um doce que lhe ofereço:



Importa de uma só vez, todas as folhas de excel que estiverem em c:\ para a tabela

Private Sub SeuBotao_Click()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
blnHasFieldNames = True
strPath = "C:" ' drive onde se situa o seu documento excel
strTable = "tblExemplo" 'nome da tabela no seu banco
strFile = Dir(strPath & "temp.xls") 'nome do seu excel, se mudar para "*.xls" importa todas as folhas excel _
que estiverem em C:\ para a tabela do banco.
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames
strFile = Dir()
Loop
End Sub

.........................................................................................


Este codigo importa o Excel para o Access, mas cria tabelas separadas com o nome dos Sheets e com todos os seus dados.

Private Sub SeuBotao_Click()
Dim appExcel As Excel.Application
Dim wb As Excel.Workbook
Dim sh As Excel.Worksheet
Dim strValue As String
Set appExcel = CreateObject("Excel.Application")
Set wb = appExcel.Workbooks.Open("C:\temp.xls") 'nome do seu excel e seu diretorio
For Each sh In wb.Sheets
Debug.Print sh.Name
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tbl_" & sh.Name, "C:\temp.xls", True, sh.Name & "!"
Next
wb.Close
appExcel.Quit
On Error GoTo 0
Exit Sub
End Sub


.......................................................................................


Este importa todos os dados de todos os sheets para a mesma tabela:

Private Sub SeuBotao_Click()
Dim appExcel As Excel.Application
Dim wb As Excel.Workbook
Dim sh As Excel.Worksheet
Dim strValue As String
Dim strTable As String
strTable = "tblExemplo" 'nome da tabela no seu banco
Set appExcel = CreateObject("Excel.Application")
Set wb = appExcel.Workbooks.Open("C:\temp.xls") 'nome do seu excel e seu diretorio
For Each sh In wb.Sheets
Debug.Print sh.Name
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, "C:\temp.xls", True, sh.Name & "!"
Next
wb.Close
appExcel.Quit
On Error GoTo 0
Exit Sub
End Sub


........................................................................................

Ou este, especificando o Range:

Private Sub SeuBotao_Click()
Dim aaa As Excel.Workbook
Dim bbb As Excel.Worksheet
Dim xl As Excel.Application
Dim strTabela As String
strTabela = "tblExemplo" 'nome da tabela no seu banco
Set xl = New Excel.Application
Set aaa = xl.Workbooks.Open("C:\temp.xls") '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, "C:\temp.xls", True, bbb.Name & "!A1:AQ500"
Next
End With
xl.Calculation = xlCalculationAutomatic
ActiveWorkbook.PrecisionAsDisplayed = True
xl.ErrorCheckingOptions.BackgroundChecking = True
aaa.Close False
End Sub


Tenha um bom final de semana.

Quero importar vários arquivos de excel como na foto abaixo para uma tabela de banco de dados usando vba do access ou do excel. como faço? Sou novo em programação VBA.

o caminho seria:

E:\Backup Cristiano\Seguranca\REC

os arquivos seriam.

01_Jan.xlsx
02_fev.xlsx até dezembro

e gostaria de ignorar os arquivos que ainda não existem porque estamos em maio por exemplo, então só seriam importados os arquivos do período que está disponível no drive.

Oi JPaulo,

Li seus exemplos, mas não consegui identificar o meu problema em nenhum deles.
Tenho vários arquivos de excel em um diretório específico, a quantidade e nomes dos arquivos variam, tem dia que tenho uns 10 outro dia tenho 80 e assim vai.Mas, sei que sempre começará da célula C5.
Nos arquivos a quantidade de linhas também é variável, posso ter arquivo com 1 linha, outro com 15, outro com 231...a unica coisa que sei é que as informações que serão coladas estão da coluna "C5" até "E", mas sem saber a qtd de linhas.
Porém há um desafio maior. Eu preciso que o nome do arquivo também seja salvo na mesma tabela dos dados colados, como se fosse um campo ao lado dos dados da tabela que foi copiada. Assim eu sei de qual arquivo é determinada informação.
Quero trazer isso para dentro do access, consolidando tudo em uma tabela única.

Pode me ajudar, já agradeço antecipadamente.

JPaulo,

faz tempo que iniciou este topico e nao sei se esta mais ativo no grupo, mas queria saber se alguém sabe como dar um auxilio na referencia abaixo explicada pelo JPaulo

o código me da uma visão do que preciso, mas eu quero também que importar dados específicos, alguns dados da tabela excel para minha tabela no access, ai no access eu preencho o que me falta

meu sistema no access funciona assim, eu recebo agendamentos via planilha no excel e digito no access, ai com o procedimento que pretendo implantar eu consigo alimentar os dados que as transportadoras me manda importando direto para meu sistema e depois preencho o restante na mao.

Código:

Ou este, especificando o Range:

Private Sub SeuBotao_Click()
Dim aaa As Excel.Workbook
Dim bbb As Excel.Worksheet
Dim xl As Excel.Application
Dim strTabela As String
strTabela = "tblExemplo" 'nome da tabela no seu banco
Set xl = New Excel.Application
Set aaa = xl.Workbooks.Open("C:\temp.xls") '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, "C:\temp.xls", True, bbb.Name & "!A1:AQ500"
Next
End With
xl.Calculation = xlCalculationAutomatic
ActiveWorkbook.PrecisionAsDisplayed = True
xl.ErrorCheckingOptions.BackgroundChecking = True
aaa.Close False
End Sub