MkDir

[Bruno_BRP]

boa tarde !

 

Estou usando o codigo abaixo para gerar uma pasta de arquivo do diretorio C:\

 

esta funcionando ok , gostaria agora de fazer ele gerar uma sub pasta com o mes corrente para manter o backup de registros por mes 

 

estava pensando em alguma varialvel que eu possa colocar no MkDir e ele entenda isso como um caminho 

 

quero usar tambem a Celula A1 que contera a informação para gerar esse caminho 

 

alguma ideia para me ajudar?

 

 

 

 

On Error Resume Next

If Len(Dir("C:Recibos", vbDirectory) & "") > 0 Then

'    MsgBox "Você está tentando criar um diretório que já existe"

Else

    If Len(Dir("C:Recibos", vbDirectory) & "") = 0 Then

   

    MkDir "C:\Recibos\"

 

 

   MsgBox "Backup em PDF ficada no C:\Recibos\"

End If

 

End If

 

[Basole]

Segue exemplo que cria a pasta backup caso nao exista e a funcao que cria backup

 

Sub CriaPasta_Backup()
    On Error Resume Next
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")   

    If fso.FolderExists(ThisWorkbook.path & "\BACKUP") Then    ' verifica se ja existe a pasta
    Else: MkDir ThisWorkbook.path & "\BACKUP"    ' se nao existir cria
    End If
End Sub

Function BackXls()
    Dim CopiaSegura As Object
    Dim Caminho As String
     MyXlsPath = ThisWorkbook.path & "\" & ThisWorkbook.Name
    Caminho = ThisWorkbook.path & "\BACKUP\"    'Nome da pasta e nome de inicio para o banco de backup
    Set CopiaSegura = CreateObject("Scripting.FileSystemObject")
    CopiaSegura.CopyFile MyXlsPath, Caminho & Format(Now, "_ddmmyyyy") & ".XLSM"
End Function

[Bruno_BRP]

Segue exemplo que cria a pasta backup caso nao exista e a funcao que cria backup

 

Sub CriaPasta_Backup()

    On Error Resume Next

    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")   

    If fso.FolderExists(ThisWorkbook.path & "\BACKUP") Then    ' verifica se ja existe a pasta

    Else: MkDir ThisWorkbook.path & "\BACKUP"    ' se nao existir cria

    End If

End Sub

Function BackXls()

    Dim CopiaSegura As Object

    Dim Caminho As String

     MyXlsPath = ThisWorkbook.path & "\" & ThisWorkbook.Name

    Caminho = ThisWorkbook.path & "\BACKUP\"    'Nome da pasta e nome de inicio para o banco de backup

    Set CopiaSegura = CreateObject("Scripting.FileSystemObject")

    CopiaSegura.CopyFile MyXlsPath, Caminho & Format(Now, "_ddmmyyyy") & ".XLSM"

End Function

 

 

é quase isso que quero que aconteça 

 

dentro da minha planilha na celula c38 tenho uma formula que faz uma contagem numérica

 

quero que este numero seja meu arquivo 

 

ficaria essa sequencia 

 

backup > Mês > Recibo 01.pdf

 

fiz um teste nas linhas que me passou, mas o que eu realmete necessito é que 

 

se não tem criar arquivo 

 

se tem achar o arquivo e salvar dentro do mês o PDF

 

 

ate gerar o PDF eu estou conseguindo , o problema é que não estou conseguindo fazer gerar uma pasta com o mês antes 

é quase isso que quero que aconteça 

 

dentro da minha planilha na celula c38 tenho uma formula que faz uma contagem numérica

 

quero que este numero seja meu arquivo 

 

ficaria essa sequencia 

 

backup > Mês > Recibo 01.pdf

 

fiz um teste nas linhas que me passou, mas o que eu realmete necessito é que 

 

se não tem criar arquivo 

 

se tem achar o arquivo e salvar dentro do mês o PDF

 

 

ate gerar o PDF eu estou conseguindo , o problema é que não estou conseguindo fazer gerar uma pasta com o mês antes 

 

 

 

 

Segue exemplo que cria a pasta backup caso nao exista e a funcao que cria backup

 

Sub CriaPasta_Backup()

    On Error Resume Next

    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")   

    If fso.FolderExists(ThisWorkbook.path & "\BACKUP") Then    ' verifica se ja existe a pasta

    Else: MkDir ThisWorkbook.path & "\BACKUP"    ' se nao existir cria

    End If

End Sub

Function BackXls()

    Dim CopiaSegura As Object

    Dim Caminho As String

     MyXlsPath = ThisWorkbook.path & "\" & ThisWorkbook.Name

    Caminho = ThisWorkbook.path & "\BACKUP\"    'Nome da pasta e nome de inicio para o banco de backup

    Set CopiaSegura = CreateObject("Scripting.FileSystemObject")

    CopiaSegura.CopyFile MyXlsPath, Caminho & Format(Now, "_ddmmyyyy") & ".XLSM"

End Function

 

 

o que fiz ate o momento foi isso, se tem uma pasta ele ja salva o arquivo se não tem ele cria a pasta e salva , agora queto deixar os arquivos salvos dentro do mes em uma pasta por mes dentro de backup

 

obrigado 

 

 

 

'CRIA O PRIMEIRO ARQUIVO SE NÃO TIVER

On Error Resume Next

If Len(Dir("C:Recibos", vbDirectory) & "") > 0 Then

'    MsgBox "Você está tentando criar um diretório que já existe"

Else

    If Len(Dir("C:Recibos", vbDirectory) & "") = 0 Then

    MkDir "C:\Recibos\"

 

   MsgBox "Backup em PDF ficada no C:\Recibos\"

End If

 

End If

 

 

'SALVA O ARQUIVO EM PDF NA PASTA ESCOLHIDA

 

Dim nome As String

Dim endereco As String

 

'E O LOCAL ONDE SALVA O ARQUIVO MAIS O NOME DO ARQUIVO E O NUMERO DO PEDIDO

 

nome = "C:\Recibos\" & Range("c38").Value & ".pdf"

 

'LINHAS SELECIONADAS QUE APARECERAM NO PDF

 

ActiveSheet.Range("C3:I38").ExportAsFixedFormat Type:=xlTypePDF, Filename:=nome

Obrigado a todos , estou fechando este post pois chequei no meu objetivo 

 

 

segue 

 

 

Private nova_pasta()

 

Dim Path As String

Dim D As String

Dim File1 As String

Path = "C:\Recibos\"

D = Format(Now, "MMMM") & "\"

File1 = Path & nome & D

 

On Error Resume Next

If Len(Dir((File1), vbDirectory) & "") > 0 Then

Else

    If Len(Dir((File1), vbDirectory) & "") = 0 Then

    MkDir "C:Recibos"

    

    MkDir (File1)

 

   MsgBox "Mês de Backup foi alterado C:\Recibos\"

End If

 

End If

 

nome = (File1) & Range("c38").Value & ".pdf"

 

'LINHAS SELECIONADAS QUE APARECERAM NO PDF

 

ActiveSheet.Range("C3:I38").ExportAsFixedFormat Type:=xlTypePDF, Filename:=nome

 

End Sub