O código abaixo com adaptações pode ser utilizado para importação de vários arquivos txt?
Código: Selecionar todos
Sub ImportarArq()
Dim cn As Object
Dim Fd As Office.FileDialog
Dim rsTAB As Recordset
Dim rs As Object
Dim Ws As String
Dim query As String
Dim nTab As Variant
Dim SelectFile As Variant
Dim i As Long
Dim Caminho As String
Set Fd = Application.FileDialog(msoFileDialogFilePicker)
With Fd
.AllowMultiSelect = True
.Title = "Please select the file" '
.InitialFileName = "C:\Users\" & Environ("Username")
'.InitialFileName = ThisWorkbook.Path & "\Arquivos"
.Filters.Clear
.Filters.Add "Excel", "*.xls*"
.Filters.Add "All Files", "*.*"
If .Show = True Then
'Instancia e configura o objeto cn.
Set cn = New ADODB.Connection
' Incia um laço entre todos os arquivos selecionados.
For i = 1 To .SelectedItems.Count
Caminho = .SelectedItems(i)
' Abre a conexão com o Arquivo.
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties").Value = "Excel 8.0"
.Open Caminho
End With
' Instancia o Schema das Tabelas.
Set rsTAB = cn.OpenSchema(adSchemaTables)
' Inicia novo laço entre as tabelas existentes no arquivo.
Do While Not rsTAB.EOF
nTab = rsTAB!TABLE_NAME
If Not (nTab Like "MSys*" Or nTab Like "~*" Or nTab Like "sys*") Then
Let Ws = nTab
Exit Do
End If
rsTAB.MoveNext
Loop
' Atribui comando de consulta na variável Query.
Let query = "SELECT * FROM [" & Ws & "]"
' Intancia um RecordSet
Set rs = New ADODB.Recordset
' Executa a consulta, envia para planilha e fecha o objeto.
rs.Open query, cn
Planilha6.Range("A" & Application.WorksheetFunction.CountA(Planilha6.Columns(1)) + 1).CopyFromRecordset rs
rs.Close
' Fecha conexão do Objeto cn.
cn.Close
Next i
Else
Exit Sub
End If
End With
' Limpa instância do Objeto cn.
Set cn = Nothing
End Sub