Basole

Sim, considerando que sua tabela esteja no access.

Infelizmente não tenho o Selenium instalado na minha máquina e não posso ajudar. Vamos esperar algum colega.

@Aron Gerd Ristow Filho este código pra mim está funcionando, abre o último arquivo *.xl* modificado. Pelo que entendi esse é o objetivo, correto ?

@Douglas ianes veja este exemplo: Exemplo salvar como *.xlsx

Faca um select top para importar as quantidades de linhas desejadas, exemplo: Sql = "SELECT TOP 1000 * FROM [SuaTabela]"

Esses seus codigos estão muito confusos. Por favor, envie um arquivo do Excel com esses dados importados manualmente, demostrando o resultado esperado.

@kiNG796 qual o codigo que esta usando?

@Jvitorino1007 faltou enviar o arquivo "Test.docx", que esta sendo referenciado no codigo. @Jvitorino1007 sem esse arquivo nao posso testar. Vamos esperar se algum colega pode lhe ajudar.

@Joao Otavio Silva As guias estão ocultas por isso não tem acesso, você precisa alterar está opção, veja como neste link Ocultar as guias do excel

@Jvitorino1007 seria o bom se pudesse enviar os arquivos para testar e analisar o seu senário. .

@Joao Otavio Silva segue o arquivo com as alteracoes solicitadas. Veja se e isso ! tabela livros ESTANTES.zip

@aprendiz_vba seria bom ao invés de eu ficar supondo, voce anexar os exemplos de arquivos txt que serao importados

@Jvitorino1007 voce nao especificou, mas suponho que queira inserir outra imagem, na proxima pagina... * Altere a variavel nome pela da outra imagem With docativo .Range.Paragraphs.Last.Range.InsertParagraphAfter Set nxPara = .Paragraphs.Last nxPara.Range.InsertBreak Type:=wdPageBreak Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True) s.Width = 400 ' Insere outra imagem em outra pagina .Range.Paragraphs.Last.Range.InsertParagraphAfter Set nxPara = .Paragraphs.Last nxPara.Range.InsertBreak Type:=wdPageBreak Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True) s.Width = 400 End With

@aprendiz_vba eu suponho que, um arquivo txt esteja sobrepondo outro na importacao. Segue alteracoes: Public Sub Importar() Dim Ficheiro As String Dim fd As FileDialog Dim strPath As String Dim xFile As String Dim xFiles As New Collection Dim i As Long Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.AllowMultiSelect = False fd.Title = "Selecione a Pasta que contem o arquivos TXT" If fd.Show = -1 Then strPath = fd.SelectedItems(1) End If If strPath = "" Then Exit Sub If VBA.Right(strPath, 1) <> "\" Then strPath = strPath & "\" xFile = VBA.Dir(strPath & "*.txt") If xFile = "" Then MsgBox "Nenhum arquivo encontrado !", 64, "Atencao" Exit Sub End If Do While xFile <> "" xFiles.Add xFile, xFile xFile = VBA.Dir() Loop If xFiles.Count > 0 Then For i = 1 To xFiles.Count Ficheiro = strPath & xFiles.Item(i) Dim rg As Range Dim lr As Long With ActiveSheet lr = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row Set rg = .Range("A" & lr) End With Open Ficheiro For Input As #1 Dim S As String Do Until EOF(1) Line Input #1, S rg = Val(Left(S, 10)) rg.Offset(0, 0) = Mid(S, 1, 1) rg.Offset(0, 3) = Mid(S, 6, 8) rg.Offset(0, 1) = Mid(S, 21, 7) rg.Offset(0, 2) = Mid(S, 349, 45) rg.Offset(0, 4) = Ficheiro Set rg = rg.Offset(1, 0) Loop Close #1 i = i + 1 Next Call Remove_Linhas Call Ajusta_Valor End If Cells.Select Selection.Columns.AutoFit End Sub

@Joao Otavio Silva segue sugestao.,veja se atende Nesse exemplo, retorna varios resultados, o usuario nao precisa digitar todo conteudo a ser pesquisado. Por exemplo se pesquisar por autor, no resultado mostra toda as obras do mesmo * Adapte de acordo com seu lay-out. tabela livros ESTANTES.zip

@Jvitorino1007 veja agora apos esses ajustes : Private Sub CommandButton1_Click() Dim Word As Object Dim documento As Object Dim selection As Document Dim oImage As Shape Dim nxPara As Paragraph Dim s As Word.InlineShape Set Word = CreateObject("Word.Application") Word.Visible = True Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test.docx") Dim docativo Set docativo = documento With docativo .Range.Paragraphs.Last.Range.InsertParagraphAfter Set nxPara = .Paragraphs.Last nxPara.Range.InsertBreak Type:=wdPageBreak Set s = nxPara.Range.InlineShapes.AddPicture(nome, False, True) s.Width = 400 End With End Sub

Segue codigo com as alteracoes: Private Sub CommandButton1_Click() Dim Word As Object Dim documento As Object Dim selection As Document Dim oImage As Shape Set Word = CreateObject("Word.Application") Word.Visible = True Set documento = Word.Documents.Add(ThisWorkbook.Path & "\Test.docx") Dim docativo Set docativo = documento docativo.InlineShapes.AddPicture Filename:=nome, LinkToFile:=False, SaveWithDocument:=True Word.selection.InsertBreak Type:=wdPageBreak End Sub

@Jvitorino1007 Envie o codigo completo que esta utilizando..

@aprendiz_vba segue as com as alteracoes solicitadas Public Sub Importar() Dim Ficheiro As String Dim fd As FileDialog Dim strPath As String Dim xFile As String Dim xFiles As New Collection Dim i As Long Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.AllowMultiSelect = False fd.Title = "Selecione a Pasta que contem o arquivos TXT" If fd.Show = -1 Then strPath = fd.SelectedItems(1) End If If strPath = "" Then Exit Sub If VBA.Right(strPath, 1) <> "\" Then strPath = strPath & "\" xFile = VBA.Dir(strPath & "*.txt") If xFile = "" Then MsgBox "Nenhum arquivo encontrado !", 64, "Atencao" Exit Sub End If Do While xFile <> "" xFiles.Add xFile, xFile xFile = VBA.Dir() Loop If xFiles.Count > 0 Then For i = 1 To xFiles.Count Ficheiro = strPath & xFiles.Item(i) Dim rg As Range Set rg = Range("A1") Open Ficheiro For Input As #1 Dim S As String Do Until EOF(1) Line Input #1, S rg = Val(Left(S, 10)) rg.Offset(0, 0) = Mid(S, 1, 1) rg.Offset(0, 3) = Mid(S, 6, 8) rg.Offset(0, 1) = Mid(S, 21, 7) rg.Offset(0, 2) = Mid(S, 349, 45) rg.Offset(0, 4) = Ficheiro Set rg = rg.Offset(1, 0) Loop Close #1 i = i + 1 Next Call Remove_Linhas Call Ajusta_Valor End If Cells.Select Selection.Columns.AutoFit End Sub

@Marcio Lima de Lira segue o arquivo exemplo, em anexo teste_Duplicados.zip

@Rodinei Cirineu Veja se e isso que precisa: On Error Resume Next strComputer = "." Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") ' Create Excel Spreadsheet Set app = CreateObject("Excel.Application") Set wb = GetObject("R:\Inventário.xlsx") ' app.Visible = True wb.Activate wb.Parent.Windows(1).Visible = True Set ws = wb.Worksheets(1) LastRow = ws.UsedRange.Rows.Count + 1 ' ' Get Computer System Details Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem", , 48) For Each objItem In colItems ws.Cells(LastRow, 1).Value = "" & objItem.Caption ws.Cells(LastRow, 2).Value = "" & objItem.UserName ws.Cells(LastRow, 3).Value = "" & objItem.Manufacturer ws.Cells(LastRow, 4).Value = "" & objItem.Model Next Set objWMIService = Null Set colItems = Null ' 'Get BIOS Details Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS", , 48) For Each objItem In colItems ws.Cells(LastRow, 5).Value = "" & objItem.SerialNumber Next Set objWMIService = Null Set colItems = Null ' ' Get CPU Details Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor", , 48) For Each objItem In colItems ws.Cells(LastRow, 6).Value = "" & objItem.Name ws.Cells(LastRow, 7).Value = "" & objItem.CurrentClockSpeed Next Set objWMIService = Null Set colItems = Null ' ' Get OS Details Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem", , 48) For Each objItem In colItems ws.Cells(LastRow, 8).Value = "" & objItem.Caption ws.Cells(LastRow, 9).Value = "" & objItem.CSDVersion ws.Cells(LastRow, 10).Value = "" & FormatNumber(objItem.TotalVisibleMemorySize / 1024, 0) Next Set objWMIService = Null Set colItems = Null ' ' Get & Writeout current Date ws.Cells(LastRow, 11).Value = "" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) 'Save app.DisplayAlerts = False strExcelPath = strCurDir & "staff_PC_inventory.xlsx" app.DisplayAlerts = True wb.Save app.Quit

Veja se este exemplo lhe atende: Sub Listar_Accdb_Local() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim i As Integer Dim pasta As FileDialog Dim sItem As String Set pasta = Application.FileDialog(msoFileDialogFolderPicker) With pasta .Title = "Selecione uma Pasta" .AllowMultiSelect = False If .Show <> -1 Then sItem = "" If sItem = "" Then Exit Sub Else sItem = .SelectedItems(1) End If End With Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(sItem) i = 1 'limpa o intervalo With ActiveSheet .Range("A:B").EntireColumn.ClearContents 'Escreve o cabeçalho .Cells(1, 1).Value = "Nome Arquivo" .Cells(1, 2).Value = "Local do Arquivo" For Each objFile In objFolder.Files If objFile.Name Like "*.*cdb" Then 'nome arquivo .Cells(i + 1, 1) = objFile.Name 'caminho arquivo .Cells(i + 1, 2) = VBA.Left(objFile.Path, Vba.InStrRev(objFile.Path, "\")) i = i + 1 End If Next objFile End With End Sub

@Pedro Gledson O problema é com a propriedade do componente txtPontoEmbarque Nao aceita a propriedade .Text Deixe simplesmente como txtPontoEmbarque

Somente com imagens, não consigo lhe ajudar. Vamos ver se algum colega pode.

@leandromgp Qual solucao esta se referindo? Poste o codigo especifico, para que possamos ajusta-lo