Dica: Criando Diretórios no Windows (Pastas e Subpastas)

Certa vez, precisei criar uma árvore de pastas no Windows. Lembro-me de ter sido uma tarefa bastante exaustiva, pois envolvia 200 pastas, e cada pasta continha cerca de 12 subpastas.

Não contente com o trabalha braçal, resolvi procurar por alguma solução alternativa para o meu problema.

E a resposta foi VBA! Irei explicar agora o desafio, e exemplificá-lo, para facilitar.

Antes de tudo, planilhei o nome das pastas que precisei criar, respeitando a seguinte hierarquia: criando primeiro as pastas principais, e em seguida suas subpastas.

Em seguida, fui até a área de código VBA, através do atalho "Alt + F11".
Inseri um novo módulo e escrevi o seguinte código:

O código em questão:

Sub criardir()
For i = 1 To 27
    MkDir (Range("A" & i))
Next
End Sub

Vamos à explicação do código:

O comando iniciado por For e encerrado por Next é um laço.
Isso significa que será repetido o que está entre o For e o Next por um número predefinido de vezes.

Para utilizar o For... Next, precisaremos de uma variável que receberá um valor a cada repetição.

Nesse caso, foi definido um valor pra variável "i": de 1 a 27. A partir disso, esse comando executa 27 repetições, onde, em cada uma delas o valor do "i" é alterado para o valor da repetição em questão, começando por 1, em seguida por 2, 3 e assim sucessivamente, sempre encerrando no Next e voltando para a primeira linha do For, até que se conclua as 27 repetições. Podemos também aproveitar o valor do "i" para questões que veremos a seguir.

Já o comando MkDir("Caminho do Diretório") é o responsável pela criação do diretório, sendo necessário respeitar a árvore hierárquica dos diretórios, criando primeiro as pastas raízes, como "T:\Diretorios", e em seguida as subpastas, como "T:\Diretorios\Empresa 1", e assim sucessivamente, como "T:\Diretorios\Empresa 1\Mes 1", "T:\Diretorios\Empresa 1\Mes 2".

O que fiz foi definir que, a cada vez que a função For se repita, dentre as 27 vezes definidas, o valor dentro do MkDir() seja o mesmo de uma das células que escrevi os nomes dos diretórios anteriormente na planilha.

O comando que pega o valor das células da planilha é o Range("A1") por exemplo, que pega o valor da célula A1 e trás para o VBA.
Porém, como eu queria o valor das células A1 até a A27, troquei a número da linha da célula de "1" pelo "i". Lembrando que o "i" será alterado a cada repetição do For... Next.

Dessa maneira, toda vez que o For rodar e der um novo valor para o "i", ele representará o número da linha da célula correspondente e me trará o valor contido nela, ficando assim: Range("A" & i). O caractere "&" serve para juntar a coluna "A" com a linha "i". Se o "i" vale 5, resultaria automaticamente em "A5".

Caso tenha que criar 1000 diretórios, basta ajustar o For, de 1 to 27 para For i = 1 to 1000.
E caso os nomes das pastas estejam em outra coluna, troque o A pela letra da coluna correspondente.

Bom, é isso!

Dica: Renomear arquivos no Windows através do VBA no Excel

Se você precisa renomear arquivos no Windows, tenho aqui uma solução rápida para você.

No Excel, abra a área de códigos VBA através do atalho no seu teclado "Alt + F11".

Em seguida, insira um módulo: Inserir > Módulo.

Este Módulo surgirá na árvore de opções à esquerda, como Módulo 1. Clique sobre ele.

Agora teremos à direita a área onde o código será introduzido.

Mas antes, vamos às explicações:

Um arquivo precisa ser renomeado.
Certifique-se primeiro de que ele esteja fechado.
A seguir, precisará do endereço dele, ou seja, do diretório, nome e extensão do arquivo no seguinte formato:

"C:\Pasta\Arquivo.txt"

Nesse caso, preciso que meu Arquivo.txt seja renomeado para ArquivoTexto.txt.

A linha de comando é bem simples:

Name "x" as "y"

Sendo x entre aspas o diretório original, e y entre aspas o novo diretório, a ser renomeado.

No módulo VBA, digite a seguinte expressão:

Sub renomear()
Name "C:\Pasta\Arquivo.txt" as "C:\Pasta\ArquivoTexto.txt"
End sub

Por fim, execute o código clicando sobre o ► Play "verde", na barra de tarefas acima e confira o resultado abrindo a pasta onde o arquivo se encontra.

Outro exemplo:

Sub renomear()
Name "C:\Pasta\Arquivo.txt" as "C:\Pasta\ArquivoTexto.txt"
Name "C:\Pasta\Arquivo2.txt" as "C:\Pasta\ArquivoTexto2.txt"
Name "C:\Pasta\MeuTexto.txt" as "C:\Pasta\ArquivoTexto3.txt"
Name "C:\Pasta\Planilha.xlsx" as "C:\Pasta\MinhaPlanilha.xlsx" 
End sub

Lembrando que esse método só convém ser realizado em modificações em massa. Você pode através do CMD gerar um log do comando DIR na pasta onde seus arquivos estão, e em seguida montar o código numa planilha de Excel, levando o resultado para um módulo VBA, executando-o em seguida.

Qualquer dúvida deixe seu comentário! ^_^

Função Super Trim

Na programação em geral, o termo TRIM refere-se à algoritmos para remoção de espaços extras contidos em um texto, ou seja, é uma espécie de faxina, que limpa alguns excessos.

Pensando nisso, fui além e elaborei uma função um pouco mais complexa, que realiza uma varredura não só nas bordas do texto, como também em seu interior.

Exemplo:

Texto antigo:
"Teste    de   limpeza de     espaços .  "
Após a aplicação da função que elaborei, teremos o seguinte resultado:
"Teste de limpeza de espaços."

Elaborei duas funções, sendo a SUPERTRIM a mais complexa, e a SUPERTRIMS a mais simples, porém com o mesmo resultado.

Se na célula A1 tivermos o seguinte texto:
"Só    estou    testando.  "
A função SUPERTRIM funcionará da seguinte maneira:
=SUPERTRIM( célula ou "texto" ; "texto a ser substituido" ; "pelo texto")
=SUPERTRIM(A1;"  ";" ")
Resultado: "Só estou testando."

Um outro exemplo seria o seguinte:
Ainda na célula A1, temos o seguinte texto:
"Só|estou||||||testando||||esta|função."
=SUPERTRIM( célula ou "texto" ; "texto a ser substituido" ; "pelo texto")
=SUPERTRIM(A1;"||";"|")
Resultado: "Só|estou|testando|esta|função."
Ou seja, a função SUPERTRIM não se limita somente a caracteres de espaços, podendo ela ser personalizada de acordo com cada necessidade.

Por outro lado, a função SUPERTRIMS é bem mais objetiva, porém seu alvo é especificamente o caractere de espaço.

Se na célula A1 tivermos o seguinte texto:
"Só        estou      testando.     "
A função SUPERTRIMS funcionará da seguinte maneria:
=SUPERTRIMS( célula ou "texto" )
=SUPERTRIMS(A1)
Resultado: "Só estou testando."

Segue funções:

Public Function SUPERTRIM(ByRef texto As String, ByRef caractere As String, ByRef newcaractere As String) As String
Dim textok(5000) As String
If caractere = "" Then
caractere = "  "
Else: End If
If newcaractere = "" Then
newcaractere = " "
Else: End If
textok(1) = texto
On Error GoTo endy
For i = 2 To 5000
textok(i) = WorksheetFunction.Substitute(textok(i - 1), caractere, newcaractere)
Next
endy:
SUPERTRIM = textok(i - 1)
End Function

Public Function SUPERTRIMS(ByRef texto As String) As String
Dim textok(5000) As String
caractere = "  "
newcaractere = " "
textok(1) = texto
On Error GoTo endy
For i = 2 To 5000
textok(i) = WorksheetFunction.Substitute(textok(i - 1), caractere, newcaractere)
Next
endy:
SUPERTRIMS = textok(i - 1)
End Function

É isso!

Função para Contar Caracteres Específicos no Texto de uma Célula

Outro dia surgiu a necessidade de contar quantos caracteres "@" (arroba) haviam no texto de uma célula.

Por exemplo, a célula A1 continha o texto: "meu@nome@é@esse@fim"

A fórmula retornaria o seguinte valor: 4, pois essa é a quantidade exata de @ dentro da célula.

Num outro caso, precisei contar quantos fragmentos de texto, como por exemplo, "meu_nome" haviam no texto de uma célula.

O texto era: "Aqui_entra_meu_nome_e_aqui_meu_nome_sai."

O resultado da função nesse caso seria: 2, pois o texto contém "meu_nome" duas vezes.

Se o texto que você quer está na célula A1, sua função precisará inserida em outra célula da seguinte forma:

Funcionamento: =CONTCAR( "defina aqui a célula ou algum texto" ; "defina aqui o que será procurado")

=CONTCAR(A1;"|")

Se a célula A1 aqui contiver o texto: "Meu|Número|é|123456", o resultado seria: 3, pois estaríamos procurando pela quantidade de caracteres "|" (pipe) no texto.


Segue função:

Public Function CONTCAR(ByRef Texto As String, ByVal Caractere As String) As Integer

Dim tamanho, tmn, total As Variant
total = 0
tamanho = Len(Texto)
tmn = Len(Caractere)
    For i = 1 To tamanho
 
        If Mid(Texto, i, tmn) = Caractere Then
     
            total = total + 1
     
        Else: End If
    Next
CONTCAR = total

End Function

Fim!

Função para lidar com Nomes de Arquivos

Segue aqui três funções que precisei criar em uma ocasião.

Elas servem para lidar com nomes de arquivos, exatamente como no exemplo a seguir:

A célula A1 contém o seguinte texto: C:\Pasta1\Subpasta1\ArquivoTeste.txt

Nesse caso, cada função irá retornar um resultado diferente, baseado no exemplo anterior.
A seguir, demonstro o resultado de cada função, caso estas sejam inseridas da seguinte forma em outras células:

=FILENAME(A1) resultaria em: ArquivoTeste

=FILEXT(A1) resultaria em: .txt  

=FILEDIR(A1) resultaria em: C:\Pasta1\Subpasta1\

Segue agora as funções para serem inseridas em um módulo VBA, através do "Alt + F11":

Public Function FILENAME(ByVal flname As String) As String

Dim FILEX As String

FILEX = StrReverse(Mid(StrReverse(flname), 1, WorksheetFunction.Find("\", StrReverse(flname), 1) - 1))

FILENAME = StrReverse(Mid(StrReverse(FILEX), WorksheetFunction.Find(".", StrReverse(FILEX), 1) + 1, 500))

End Function

Public Function FILEXT(ByVal flname As String) As String

Dim FILEX As String

FILEX = StrReverse(Mid(StrReverse(flname), 1, WorksheetFunction.Find("\", StrReverse(flname), 1) - 1))

FILEXT = StrReverse(Mid(StrReverse(FILEX), 1, WorksheetFunction.Find(".", StrReverse(FILEX), 1)))

End Function

Public Function FILEDIR(ByVal flname As String) As String

Dim FILEX As String

FILEDIR = StrReverse(Mid(StrReverse(flname), WorksheetFunction.Find("\", StrReverse(flname), 1), 500))

End Function

É isso!