Este fórum está sendo desativado

[CAMILOALVES01]

Bom Dia!
Solicito ajuda para avaliar a possibilidade de se implementar uma macro agregada a já existente onde sejam possíveis criar pastas em um determinado diretório (N:\Normas\xxxxxx) onde xxxxxx seriam os dados constantes na célula “L1” .
Resumindo: Se possível, a macro em questão deverá criar pastas para cada variável em “L1” para que possamos registrar posteriores informações.
OBS: Se possível também a macro não deverá permitir a criação de pastas já existentes.
Desde já agradeço.

[Basole]

@CAMILOALVES01
Acrescente nas linhas abaixo no inicio da sua macro.

Código: Selecionar todos

strpath = "N:\Normas\" & [L1]
    If VBA.Len(VBA.Dir(strpath, VBA.vbDirectory)) = 0 Then
        VBA.MkDir (strpath)
    Else
        MsgBox strpath & " ja existe! "
    Exit Sub
    End If

[CAMILOALVES01]

Prezado Basole - 20 Abr 2022 às 17:53
Primeiramente Muito Obrigado Por Dispor de Seu Tempo Para Ajudar-Me.
No Mais....Perfeito!
DEUS lhe Abençoe!
Grato

[CAMILOALVES01]

Prezado Basole - 20 Abr 2022 às 17:53
Desculpe o transtorno, estou reabrindo o tópico por solicitações de outros colaboradores conforme descritas abaixo:
Apresentei a solução aos demais departamentos que gostaram muito, porém solicitaram se possível, que fossem incluído em seu código a criação de sub-pastas automaticamente criadas em conjunto com a pasta NORMA conforme código atual, com as denominações: Administrativo; Manutenção; Produção, Qualidade, Segurança, RH.
Favor avaliar tecnicamente se é possível atender a essa solicitação.
OBS: caso Você considere viável as alterações, favor deixar flexível a quantidade de sub-pastas a serem criadas.
Anexo planilha já com seu código agregado.
Desde já agradeço

[Basole]

Desculpe mas não entendi... qual seria o caminho final do endereço com as subpastas.
Com o exemplo abaixo, como ficaria?

N:\Normas\SUBPASTAS\xxxxxx) onde xxxxxx seriam os dados constantes na célula “L1” .

[CAMILOALVES01]

Prezado Basole - 25 Abr 2022 às 13:10
Obrigado pela compreensão!
Então...
A ideia seria o seguinte: N:\ Normas \ dados constantes na célula “L1” \ SUBPASTASxxxxxx onde SUBPASTASxxxxxx teriam denominações fixas por ora como: Administrativo, Manutenção, Produção, Qualidade, ou seja a cada criação de pasta de acordo com a célula L1 deverão ser geradas as sub-pastas: Administrativo, Manutenção, Produção, Qualidade.
Se possível seria interessante não limitar a criação dessas sub-pastas e daí prá frente caso haja necessidade Eu poderia incluir por exemplo caso solicitassem uma subpasta Segurança ou RH.
OBS: Anexo foto para uma melhor explicação.
Atenciosamente

[Basole]

Só concaternar os dados:

Código: Selecionar todos

Public Sub verificar_campos_branco_AD()
Dim k As Long, c As Range, LR As Long
Dim strPath, strSubFd As String
 strSubFd = "\Administrativo\Manutenção\Producao\Qualidade"
 strPath = "N:\Normas\" & [L1]
    If VBA.Len(VBA.Dir(strPath & strSubFd, VBA.vbDirectory)) = 0 Then
        VBA.MkDir (strPath & strSubFd)
    Else
        MsgBox strPath & strSubFd & " ja existe! "
    Exit Sub
    End If
 '------------------------------------------------------------------------
  LR = Sheets("BANCO DE DADOS").Cells(Rows.Count, 2).End(3).Row + 1
  For Each c In Range("C8:C11,A5")
  Sheets("BANCO DE DADOS").Cells(LR, k + 1) = c.Value: k = k + 1
  Next c
  Sheets("BANCO DE DADOS").[F9].Copy Sheets("BANCO DE DADOS").Cells(LR, 6)
  [C8:C11] = ""
  '[B8,B10:B17] = ""
 End Sub

[CAMILOALVES01]

Prezado Basole - 25 Abr 2022 às 15:27
A princípio não funcionou (dando critica: "caminho não encontrado"), anexo planilha com as alterações para vossa análise.
OBS: A pasta "Normas" encontra-se no diretório N:\
Desde já agradeço

[Basole]

@CAMILOALVES01
Fiz as alterações, veja se é isso.

Código: Selecionar todos

Public Sub verificar_campos_branco_AD()
    Dim k As Long, c As Range, LR As Long
    Dim strPath, strSubFd As String, frSubF As Variant

    
    strPath = "N:\Normas\" & [L1] & "\"
    
    If VBA.Len(VBA.Dir(strPath, VBA.vbDirectory)) = 0 Then
        VBA.MkDir (strPath)
    Else
        MsgBox strPath & " ja existe! "
        Exit Sub
    End If

    ' Cria as SubPastas:
    
    strSubFd = "\Administrativo\Manutencao\Producao\Qualidade"
    
    frSubF = VBA.Split(strSubFd, "\")

    For i = 1 To UBound(frSubF)
        If VBA.Len(VBA.Dir(strPath & frSubF(i), VBA.vbDirectory)) = 0 Then
            VBA.MkDir (strPath & frSubF(i))
            strPath = strPath & frSubF(i) & "\"
        End If
    Next i

    '------------------------------------------------------------------------
    LR = Sheets("BANCO DE DADOS").Cells(Rows.Count, 2).End(3).Row + 1
    For Each c In Range("C8:C11,A5")
        Sheets("BANCO DE DADOS").Cells(LR, k + 1) = c.Value: k = k + 1
    Next c
    Sheets("BANCO DE DADOS").[F9].Copy Sheets("BANCO DE DADOS").Cells(LR, 6)
    [C8:C11] = ""
    '[B8,B10:B17] = ""
End Sub

[CAMILOALVES01]

Bom Dia!
Prezado Basole - 27 Abr 2022 às 22:50
Primeiramente obrigado pela paciência e dedicação.
Então...
A macro está gerando sub-pastas dentro de sub-pasta ("\Administrativo\Manutencao\Producao\Qualidade"), favor verificar pois deveria estar gerando sub-pasta dentro da pasta cujo a denominação nasce na célula “L1”, conforme foto
OBS: Anexo Planilha Para Vossa Análise, anexei na planilha também a foto das disposições das sub-pasta
Desde Já Agradeço

[Basole]

Foi desta forma que entendi que quisestes o resultado final.

N:\Normas\DIN-3450\Administrativo\Manutencao\Producao\Qualidade

Vou refazer de acordo com a imagem daqui a pouco, e atualizo aqui.

EDIT: ATUALIZANDO...

@CAMILOALVES01
Segue com as alterações:

* Se quiser que a macro continue caso já exista, a pasta DIM-3450, por exemplo, para criar as subpastas só desconsiderar a linha Exit Sub

Código: Selecionar todos

Public Sub verificar_campos_branco_AD()
    Dim k As Long, c As Range, LR As Long
    Dim strPath, strSubFd As String, frSubF As Variant
    Dim i!
    
    strPath = "N:\Normas\" & [L1] & "\"
    
    If VBA.Len(VBA.Dir(strPath, VBA.vbDirectory)) = 0 Then
        VBA.MkDir (strPath)
    Else
        MsgBox "A pasta: " & strPath & " ja existe! "
        Exit Sub
    End If

    ' Cria as SubPastas:
    
    strSubFd = "Administrativo; Manutenção; Produção; Qualidade"
    
    frSubF = VBA.Split(strSubFd, ";")

    For i = 0 To UBound(frSubF)
        If VBA.Len(VBA.Dir(strPath & VBA.Trim(frSubF(i)), VBA.vbDirectory)) = 0 Then
            VBA.MkDir (strPath & VBA.Trim(frSubF(i)))
        End If
    Next i

    '------------------------------------------------------------------------
    LR = Sheets("BANCO DE DADOS").Cells(Rows.Count, 2).End(3).Row + 1
    For Each c In Range("C8:C11,A5")
        Sheets("BANCO DE DADOS").Cells(LR, k + 1) = c.Value: k = k + 1
    Next c
    Sheets("BANCO DE DADOS").[F9].Copy Sheets("BANCO DE DADOS").Cells(LR, 6)
    [C8:C11] = ""
    '[B8,B10:B17] = ""
End Sub

[CAMILOALVES01]

Prezado Basole - 28 Abr 2022 às 09:19
Obrigado por avaliar o projeto e pela paciência
Então...
Testei e verifiquei que as pastas ISO-9000 e NBR-8977 em nosso exemplo, foram criadas fora da pasta “Normas”.
Na verdade, Elas (Pastas ISO-9000 e NBR-8977) devem ser sub-pasta da pasta “Normas”, já as recentes criadas: “Administrativo”, “Manutenção”, “Produção”, “Qualidade” devem ser sub-pastas de ISO-9000 e NBR-8977 respectivamente conforme foto abaixo.
Talvez Eu não tenha me expressado direito, anexei novamente a planilha com o novo código com uma explicação mais detalhada
Desde de Já Agradeço pela compreensão

[Basole]

@CAMILOALVES01

Desculpe. Para testar o código eu acrescentei uma linha para salvar no diretório do meu pc pois não tenho uma unidade N:

Mas já exclui e atualizei o código na minha postagem anterior.

viewtopic.php?p=70493&sid=678ded420c450 ... 206#p70493

[CAMILOALVES01]

Prezado Basole - 28 Abr 2022 às 17:09
Primeiramente Obrigado por dispor de seu tempo, paciência e dedicação.
Ficou perfeito!
DEUS lhe pague.
Muitíssimo Obrigado!