MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

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
    avatar
    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....
    avatar
    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
    avatar
    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
    avatar
    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
    avatar
    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
    avatar
    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: Dom 20 Ago 2017, 18:29