Porcurar E Renomear Arquivos

[Tricolor do ARRUDA]

Gostaria que minha macro "lesse" os nomes dos arquivos (todos, independentes se são planilhas, musicas, etc) da pasta C:\temp\musica e os relacionasse na col A da plan ativa

Eis uma macro que faz que está perto do que quero

Sub renomear()

Dim fsoObj As New FileSystemObject

Dim fsoFolder As Folder

Dim fsoFile As File

Dim strFile As String

Dim found As Boolean

Dim rng As Range

Set fsoFolder = fsoObj.GetFolder("C:\Temp\Musica\")

For Each fsoFile In fsoFolder.Files

strFile = Left(fsoFile.Name, Len(fsoFile.Name) - 4)

On Error Resume Next

found = Sheet1.Range("A1:A1000").Find(What:=strFile, _

After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _

SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Activate

If found Then

Set rng = Selection

strFile = rng.Offset(0, 1).Value

fsoObj.MoveFile fsoFile.Path,

"C:\Temp\Musica\" & strFile & Right(fsoFile.Name, 4)

End If

Next

Set fsoFolder = Nothing

Set fsoObj = Nothing

End Sub

ME ORIENTARAM A ADAPTAR O CODIGO ABAIXO NESSA MACRO, PORÉM NÃO SEI ONDE ENTRA

É só adaptar o código acima no loop. O loop já está pronto:

For Each fsoFile In fsoFolder.Files

ActiveSheet.Cells(nLin,1) = fsoFile.Name

nLin = nLin + 1Next

ALGUÉM PODE AJUDAR, OBRIGADO!

[Guest --Andre --]

Gostaria que minha macro "lesse" os nomes dos arquivos (todos, independentes se são planilhas, musicas, etc) da pasta C:\temp\musica e os relacionasse na col A da plan ativa

Eis uma macro que faz que está perto do que quero

Sub renomear()

Dim fsoObj As New FileSystemObject

Dim fsoFolder As Folder

Dim fsoFile As File

Dim strFile As String

Dim found As Boolean

Dim rng As Range

Set fsoFolder = fsoObj.GetFolder("C:\Temp\Musica\")

For Each fsoFile In fsoFolder.Files

strFile = Left(fsoFile.Name, Len(fsoFile.Name) - 4)

On Error Resume Next

found = Sheet1.Range("A1:A1000").Find(What:=strFile, _

After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _

SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Activate

If found Then

Set rng = Selection

strFile = rng.Offset(0, 1).Value

fsoObj.MoveFile fsoFile.Path,

"C:\Temp\Musica\" & strFile & Right(fsoFile.Name, 4)

End If

Next

Set fsoFolder = Nothing

Set fsoObj = Nothing

End Sub

ME ORIENTARAM A ADAPTAR O CODIGO ABAIXO NESSA MACRO, PORÉM NÃO SEI ONDE ENTRA

É só adaptar o código acima no loop. O loop já está pronto:

For Each fsoFile In fsoFolder.Files

ActiveSheet.Cells(nLin,1) = fsoFile.Name

nLin = nLin + 1Next

ALGUÉM PODE AJUDAR, OBRIGADO!

[Guest --Andre --]

Gostaria que minha macro "lesse" os nomes dos arquivos (todos, independentes se são planilhas, musicas, etc) da pasta C:\temp\musica e os relacionasse na col A da plan ativa

Eis uma macro que faz que está perto do que quero

Sub renomear()

Dim fsoObj As New FileSystemObject

Dim fsoFolder As Folder

Dim fsoFile As File

Dim strFile As String

Dim found As Boolean

Dim rng As Range

Set fsoFolder = fsoObj.GetFolder("C:\Temp\Musica\")

For Each fsoFile In fsoFolder.Files

strFile = Left(fsoFile.Name, Len(fsoFile.Name) - 4)

On Error Resume Next

found = Sheet1.Range("A1:A1000").Find(What:=strFile, _

After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _

SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Activate

If found Then

Set rng = Selection

strFile = rng.Offset(0, 1).Value

fsoObj.MoveFile fsoFile.Path,

"C:\Temp\Musica\" & strFile & Right(fsoFile.Name, 4)

End If

Next

Set fsoFolder = Nothing

Set fsoObj = Nothing

End Sub

ME ORIENTARAM A ADAPTAR O CODIGO ABAIXO NESSA MACRO, PORÉM NÃO SEI ONDE ENTRA

É só adaptar o código acima no loop. O loop já está pronto:

For Each fsoFile In fsoFolder.Files

ActiveSheet.Cells(nLin,1) = fsoFile.Name

nLin = nLin + 1Next

ALGUÉM PODE AJUDAR, OBRIGADO!

*****************************************************************************

Cara e o seguinte usa esse codigo aqui

Public Sub teste()

Dim arq As String

Dim i As Integer

Dir Application.ActiveWorkbook.Path & "\*" ' COMANDO DIR (USADO PARA RETORNAR NOME DE ARQUIVOS EM UM PATH

i = 1

arq = Dir ' VARIAVEL ARQ(STRING) RECEBE O NOME DO PRIMEIRO ARQUIVO

Do While arq <> ""

Me.Cells(i, 1) = arq 'COLOCA O NOME DO ARQUIVO NA CELULA

arq = Dir ' ARQ RECEBE O PROXIMO NOME DE ARQUIVO

i = i + 1

Loop

End Sub

Espero que te ajude

Se tiver duvidas nesse codigo pode enviar email pra mim! andrel@bf.com.br

Abracos!

Andre