-1
I’m using the following code I got here on the site
Sub Listar_Pastas()
''''''''''''''''''''
'==== Pastas ===='
''''''''''''''''''''
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim xPath As String
Dim xWs_pastas As Worksheet
Dim fso As Object
Dim fso_FOLDER As Object
Dim fso_folders As Object
Dim i As Long
Dim textoparacoluna As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Janela para escolher a pasta do diretório desejado
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Escolha a pasta"
.Show
If .SelectedItems.Count = 0 Then
Else
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
End If
'Alternatively, "if .selecteditems.count = 1 then myvar = .selecteditems(1)" can be used
End With
'On Error Resume Next
If xPath = "" Then
GoTo CleanExit 'Se o caminho da pasta não existir
End If
'Define novo Objeto FSO GetFolder
Set fso_FOLDER = fso.GetFolder(xPath)
'Apaga se houver planilha com mesmo nome existente
SheetKiller (fso_FOLDER.Name)
'Cria nova planilha da pasta
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(Sheets.Count)).Name = fso_FOLDER.Name
Set xWs_pastas = ThisWorkbook.Sheets(fso_FOLDER.Name)
'https://stackoverflow.com/a/31428399/7690982
'Encontra todos os Arquivos
i = 3
If fso_FOLDER.subFolders.Count > 0 Then
'Loop em cada pasta do diretório escolhido
For Each fso_folders In fso_FOLDER.subFolders
With xWs_pastas
'Preenche a coluna A com a lista de arquivos
.Cells(i, "A") = fso_folders.Name
End With
i = i + 1
Next fso_folders
Else
MsgBox "Nenhuma pasta encontrada em " & xPath
GoTo CleanExit
End If
If xPath <> "" Then
Call TextoParaColuna
End If
'Sair do código
CleanExit:
Set fso = Nothing
Set fso_FOLDER = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Ocorreu um erro em: " & Err.Number & " " & Err.Description
End Sub
Public Function SheetKiller(Name As String)
Dim s As Worksheet, t As String
Dim i As Long, k As Long
k = ThisWorkbook.Sheets.Count
For i = k To 1 Step -1
t = ThisWorkbook.Sheets(i).Name
If t = Name Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets(i).Delete
Application.DisplayAlerts = True
End If
Next i
End Function
It works the way I had asked but I need to make a modification in the part where it erases if there is a spreadsheet with an existing name, I even tried some things, but I ended up creating some very strange mistakes that Leave the whole spreadsheet.
What I need is that when it detects that the spreadsheet already exists,
In case I can’t delete the spreadsheet because it causes an error in a dynamic table that I have, then the spreadsheets that are the months (from 1 to 12) should always exist, but when clicking on the macro and listing the month 4 for example, the content has to be deleted but the spreadsheet must continue to exist so as not to spoil the dynamic table. I don’t know if there’s any other way to do it
– Paulo Cordeiro
Changed code, now it will just clean the desired spreadsheet
– Evilmaax