MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Criar pasta e sub-pasta

    Compartilhe

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    [Resolvido]Criar pasta e sub-pasta

    Mensagem  Roberto_1977 em Qui 04 Set 2014, 10:38

    Bom dia,

    Estou com um pekeno proble na minha BD.
    Não estou conseguindo resolver.... Tenho um butão onde quero guardar um ficheiro numa pasta com um nome e numa sub pasta com outro nome.
    codigo abaixo que tenho :

    Private Sub Command170_Click()
    Dim strArquivo As String
    Dim strLocal As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    strArquivo = "Interno - " & Me!Text339 & " - " & Me.Text406 & ".pdf"
    strLocal = CurrentProject.Path & "\PDF\" & Me.Text126 & "\" & Me.Text411 & "\" & strArquivo
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Msg = " Deseja guardar os dados da BD?"
    Style = vbYesNo + vbInformation + vbDefaultButton2
    Title = "Guardar Base Dados."
    Help = "Ajuda.HLP"
    Ctxt = 1000
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbYes Then
    MyString = "Sim"
    If fso.folderexists(CurrentProject.Path & "\PDF\" & Me.Text126 & "\" & Me.Text411) Then
    MkDir CurrentProject.Path & "\PDF\" & Me.Text126 & "\" & Me.Text411
    Command378_Click
    DoCmd.OutputTo acOutputReport, "interno1", acFormatPDF, strLocal, False
    MsgBox "Arquivo gerado com sucesso.", vbInformation, "Enviar para Pasta Arquivo"
    CurrentDb.Execute "delete * from Folha1"
    Text333.Value = Null
    Text126.Value = Null
    Text124.Value = Null
    Text174.Value = Null
    Combo256.Value = Null
    Combo266.Value = Null

    Form_sub_report_metros.Requery
    Exit Sub
    Else
    MkDir CurrentProject.Path & "\PDF\" & Me.Text126 & "\" & Me.Text411 'Aqui diz q não encontra pasta
    Command378_Click
    DoCmd.OutputTo acOutputReport, "interno1", acFormatPDF, strLocal
    MsgBox "Arquivo gerado com sucesso.", vbInformation, "Enviar para Pasta Arquivo"
    DoCmd.Close acTable, "Folha1"
    CurrentDb.Execute "delete * from Folha1"
    Text333.Value = Null
    Text126.Value = Null
    Text124.Value = Null
    Text174.Value = Null
    Combo256.Value = Null
    Combo266.Value = Null
    Me.Requery
    End If
    Else
    MyString = "Não"
    CurrentDb.Execute "delete * from Folha1"
    Text333.Value = Null
    Text126.Value = Null
    Text124.Value = Null
    Text174.Value = Null
    Combo256.Value = Null
    Combo266.Value = Null

    Me.Requery
    End If
    End Sub

    obrigado pela ajuda....

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Criar pasta e sub-pasta

    Mensagem  Roberto_1977 em Qui 04 Set 2014, 13:09

    Boa tarde,

    Após algumas tentativas, consegui resolver problema.

    Obrigado... Cool Cool

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Criar pasta e sub-pasta

    Mensagem  Roberto_1977 em Qui 04 Set 2014, 17:47

    Boa tarde,

    Afinal um problema resolvi, mas agora estou com outro.
    O que aconteçe é que ao criar a pasta e sub pasta ex: Pasta1 e sub-pasta1, ao criar um outro ficheiro para
    a pasta1 mas para sub-pasta2 ele não dá.
    vou postar o código:
    Private Sub Command170_Click()
    Dim strArquivo As String
    Dim strLocal As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    strArquivo = "Interno - " & Me!Text339 & " - " & Me.Text406 & ".pdf"
    strLocal = CurrentProject.Path & "\PDF\" & Me.Text126 & "\" & Me.Text411 & "\" & strArquivo
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Msg = " Deseja guardar os dados da BD?"
    Style = vbYesNo + vbInformation + vbDefaultButton2
    Title = "Guardar Base Dados."
    Help = "Ajuda.HLP"
    Ctxt = 1000
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    If Response = vbYes Then
    MyString = "Sim"
    If fso.folderexists(CurrentProject.Path & "\PDF\" & Me.Text126 & "\" & Me.Text411) Then
    Command378_Click
    DoCmd.OutputTo acOutputReport, "interno1", acFormatPDF, strLocal, False
    MsgBox "Arquivo gerado com sucesso.", vbInformation, "Enviar para Pasta Arquivo"
    CurrentDb.Execute "delete * from Folha1"
    Text333.Value = Null
    Text126.Value = Null
    Text124.Value = Null
    Text174.Value = Null
    Combo256.Value = Null
    Combo266.Value = Null
    Combo377.Value = Null
    Text411.Value = Null
    Text406.Value = "100%"
    Check402.Value = 0
    Check404.Value = -1
    Me.Requery
    Exit Sub
    Else
    MkDir CurrentProject.Path & "\PDF\" & Me.Text126
    MkDir CurrentProject.Path & "\PDF\" & Me.Text126 & "\" & Me.Text411
    Command378_Click
    DoCmd.OutputTo acOutputReport, "interno1", acFormatPDF, strLocal
    MsgBox "Arquivo gerado com sucesso.", vbInformation, "Enviar para Pasta Arquivo"
    DoCmd.Close acTable, "Folha1"
    CurrentDb.Execute "delete * from Folha1"
    Text333.Value = Null
    Text126.Value = Null
    Text124.Value = Null
    Text174.Value = Null
    Combo256.Value = Null
    Combo266.Value = Null
    Combo377.Value = Null
    Text411.Value = Null
    Text406.Value = "100%"
    Check402.Value = 0
    Check404.Value = -1
    Me.Requery
    End If
    Else
    MyString = "Não"
    CurrentDb.Execute "delete * from Folha1"
    Text333.Value = Null
    Text126.Value = Null
    Text124.Value = Null
    Text174.Value = Null
    Combo256.Value = Null
    Combo266.Value = Null
    Combo377.Value = Null
    Text411.Value = Null
    Text406.Value = "100%"
    Check402.Value = 0
    Check404.Value = -1
    Me.Requery
    End If
    Command253.Enabled = False
    Command170.Enabled = False
    Command297.Enabled = False
    End Sub

    obg. Cool

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Criar pasta e sub-pasta

    Mensagem  Roberto_1977 em Sex 05 Set 2014, 13:56

    Alguma novidade caros mestres??

    Embarassed

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Criar pasta e sub-pasta

    Mensagem  Roberto_1977 em Seg 08 Set 2014, 14:07

    continuo tentando mas sem resultado..... Sad

    Roberto_1977
    Super Avançado
    Super Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 836
    Registrado : 01/10/2013

    Re: [Resolvido]Criar pasta e sub-pasta

    Mensagem  Roberto_1977 em Seg 08 Set 2014, 14:43

    Acho que desta é de vez, alterei o código e fiz alguns testes e esta funcionando... Laughing Razz

    Obrigado...

      Data/hora atual: Sab 03 Dez 2016, 15:36