• 0
Sign in to follow this  
Tricolor do ARRUDA

Porcurar E Renomear Arquivos

Question

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!

Share this post


Link to post
Share on other sites

2 answers to this question

Recommended Posts

  • 0
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!

Share this post


Link to post
Share on other sites
  • 0
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! [email protected]

Abracos!

Andre

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this