RODRIGO ZAMENGO

Basole, muito obrigado pela ajuda Se puder me ajudar em mais uma coisa, é possivel adapatar essa macro para listar também os arquivos que estiverem em sub pastas. Muito obrigado desde já pela ajuda

Bom dia, Estou precisando encontrar todos os access (.accdb) em um diretório e retornar com o nome dos arquivos na coluna A de um excel e o local onde o arquivo está salvo na coluna B. Eu achei uma macro (no site https://www.exceldoseujeito.com.br/macro-para-localizar-arquivos-no-computador-e-listar-na-planilha/) que encontra .mp3 e traz o nome mas não consegui adaptar Sub Listar_arquivos_mp3() Dim i As Long Dim sh As Worksheet Dim iSomaMb As Double Dim sPasta As Variant Dim iLinha As Long Set sh = ThisWorkbook.ActiveSheet 'Exibe a caixa para escolha da pasta onde será feita a pesquisa sPasta = GetPasta If sPasta = "" Then Exit Sub 'Cancela pesquisa End If 'Apaga o conteúdo sh.Range("B:C").EntireColumn.ClearContents 'Escreve o cabeçalho sh.Cells(4, 2).Value = "Música" sh.Cells(4, 3).Value = "Tamanho (Mb)" 'Define a linha inicial da listagem iLinha = 5 Application.StatusBar = "Aguarde... Pesquisando ... " 'Usa o objeto de pesquisa With Application.FileSearch .LookIn = sPasta 'Define a pasta onde será pesquisado .Filename = "*.mp3" 'Define o termo da pesquisa .SearchSubFolders = True 'Informa se será feita a pesquisa nas subpastas .Execute 'Executa a pesquisa Ohhhhh!!!! 'Percorre os itens encontrados e escreve na planilha For i = 1 To .FoundFiles.Count sh.Cells(iLinha, 2).Value = .FoundFiles(i) sh.Cells(iLinha, 3).Value = CDbl(Format((FileLen(.FoundFiles(i)) / 1048576), "0.00")) iSomaMb = iSomaMb + sh.Cells(iLinha, 3).Value iLinha = iLinha + 1 Application.StatusBar = "Preenchendo lista ... " & Format(i / .FoundFiles.Count, "0%") Next i sh.Cells(1, 2).Value = "Músicas em " & sPasta sh.Cells(2, 2).Value = "Total de Músicas: " & .FoundFiles.Count sh.Cells(3, 2).Value = "Espaço Utilizado: " & Format(iSomaMb, "0.00") & " MB" End With sh.Range("A1").Select Application.StatusBar = False End Sub Tks

entendi, desculpe erro meu

A macro que usa o botão funcionou perfeitamente (muito obrigado), mas a segunda não funcionou, o erro mostra que faltou um if para o else, mas como a primeira esta funcionando nem precisa se preocupar que ja solucionou.

Eu uso esse sub enviar_email () Application.DisplayAlerts = False Application.ScreenUpdating = False Dim MyOlapp As Object, MeuItem As Object Set MyOlapp = CreateObject("Outlook.Application") Set MeuItem = MyOlapp.CreateItem(olMailItem) With MeuItem .to = ("e-mail") .Subject = "titulo" .Attachments.Add "caminho\arquivo.xlsx" .Display .Send end sub Onde eu coloquei e-mail, adicione o e-mail de destino (para colocar mais de um coloque "e-mail1;e-mail2;e-mail3"); Onde eu coloquei titulo, coloque o titulo do e-mail (não necessariamente o nome do arquivo) Onde eu coloquei caminho, coloque o caminho (ex: c:\teste.xlsx) Boa sorte

eu estou tendo o mesmo problema, onde aparece o mesmo erro (1004) , mas ocorre quando eu estou tentando rodar uma macro em outra planilha, usando Sub rodarmacroteste() Application.Run "caminho\arquivo.xlsm!teste" End Sub porém a mensagem de erro é que a macro pode não estar acessivel nessa planilha ou as macros podem estar desabilitadas

Bom dia, eu estou tentanto identificar um valor para uma lista muito grande e queria fazer uma macro para ela ahar para mim, a ideia seria eu colar o valor em uma célula, por exemplo J10, e que a macro usando o valor nessa célula me mostrasse em qual linha esta esse valor. eu pensei em utilizar essa macro que achei na internet, mas nao sei como adaptar para esse caso. Sub buscavalor() ' ' buscavalor Macro Range("A1").Select ' seleciona a primera linha da coluna a ser analisada Do Until ActiveCell = fim ' executa a macro até encontrar a palavra fim no fim da coluna a ser analisada ActiveCell.Offset(1, 0).Select 'desce uma linha If ActiveCell = x Then 'faz a análise lógica Application.Run "Macro2" ' executa a macro2 End If Loop Range("A1").Select ' retorna para o inicio da coluna End Sub Sub Macro2() ActiveCell.Offset(0, 1).Select 'desloca para a coluna a direita ActiveCell.FormulaR1C1 = "valor localizado" ActiveCell.Offset(0, -1).Select 'retorna para a coluna a esquerda End Sub