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

    Criar diretório em Documentos do Windows 7 através do VBA

    Compartilhe

    infosoft
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 250
    Registrado : 09/07/2012

    Criar diretório em Documentos do Windows 7 através do VBA

    Mensagem  infosoft em Seg 30 Jun 2014, 17:01

    Olá pessoal,
    Não estou conseguindo criar um diretório dentro da pasta Documentos no Windows 7. Alguém pode me ajuda?
    Informo que o computador está em rede e qualquer usuário pode criar subpastas em sua própria pasta Documentos... Mas porque o VBA não consegue fazer isso para o usuário automáticamente.

    ===== CÓDIGO =====

    Private Sub ButPDF_Click()
    On Error Resume Next
    DoCmd.SetWarnings False
    Me.Requery

    Dim strArquivo As String
    Dim strLocal As String
    'Dim strCOD2 As String
    'Dim strArquivoCOD2 As String

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    'If fso.folderexists("D:\GEAPDATA Or D:\GEAPDATA\Arquivos") Then 'verifica se já existe a pasta
    If fso.folderexists("D:\Users\" & Me.urede & "\Documentos\GEAPDATA\Arquivos") Then ' verifica se já existe a pasta
    'MsgBox "A pasta já existe!"
    Else
    'MkDir ("D:\GEAPDATA")
    'MkDir ("D:\GEAPDATA\Arquivos")
    MkDir ("D:\Users\" & Me.urede & "\Documentos\GEAPDATA")
    MkDir ("D:\Users\" & Me.urede & "\Documentos\GEAPDATA\Arquivos")
    'MsgBox "Nova pasta criada!"
    End If
    strArquivo = Me.cboRel
    'strUser = Me.urede
    'strLocal = "D:\GEAPDATA\Arquivos\" & Me.boxData & "_" & Me.cboRel & ".pdf"
    strLocal = "D:\Users\" & Me.urede & "\Documentos\GEAPDATA\Arquivos\" & Me.boxData & "_" & Me.cboRel & ".pdf"
    'Abre o relatório devidamente filtrado e oculto
    DoCmd.OpenReport strArquivo, acViewPreview, , strArquivo, acHidden
    'Gera arquivo pdf do relatório previamente aberto e filtrado.
    DoCmd.OutputTo acOutputReport, strArquivo, acFormatPDF, strLocal
    'Fecha o relatório
    DoCmd.Close acReport, "strArquivo"
    Dim Msg As String
    Msg = MsgBox("Deseja abrir a pasta onde foi criado o arquivo PDF?" _
    , vbYesNo, "Abrir pasta")
    If Msg = vbNo Then
    DoCmd.Close acForm, Me.Name
    Exit Sub
    End If
    If Msg = vbYes Then
    DoCmd.Close acForm, Me.Name
    'Shell "explorer.exe D:\GEAPDATA\Arquivos", vbNormalFocus
    Shell "explorer.exe D:\Users\" & Me.urede & "\Documentos\GEAPDATA\Arquivos", vbNormalFocus
    Exit Sub
    End If

    End Sub

    ================

    Desde já agradeço... Luz e Paz!

    daniloreiis
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 315
    Registrado : 14/02/2011

    Criar diretório em Documentos do Windows 7 através do VBA

    Mensagem  daniloreiis em Seg 30 Jun 2014, 20:16

    Boa tarde!

    testei seu código aqui e deu certo, porém fiz o teste na minha maquina local e mudei seu codigo colocando o caminho do diretorio na mão assim:

    seu codigo:

    Código:
    If fso.folderexists("D:\Users\" & Me.urede & "\Documentos\GEAPDATA\Arquivos") Then ' verifica se já existe a pasta
    Else
    MkDir ("D:\Users\" & Me.urede & "\Documentos\GEAPDATA")
    MkDir ("D:\Users\" & Me.urede & "\Documentos\GEAPDATA\Arquivos")

    meu codigo:

    Código:
    If fso.folderexists("C:\Users\Danilo\Desktop\GEAPDATA\Arquivos") Then ' verifica se já existe a pasta
    Else
    MkDir ("C:\Users\Danilo\Desktop\GEAPDATA")
    MkDir ("C:\Users\Danilo\Desktop\GEAPDATA\Arquivos")
    End If


    verifica se esta correto o nome do usuario nessa varivel "Me.urede" se preferir troque isso por isto: Environ("USERNAME")

    testei aqui e deu certo também

    Código:
    If fso.folderexists("C:\Users\" & Environ("USERNAME") & "\Desktop\GEAPDATA\Arquivos") Then ' verifica se já existe a pasta
    'MsgBox "A pasta já existe!"
    Else
    'MkDir ("D:\GEAPDATA")
    'MkDir ("D:\GEAPDATA\Arquivos")
    MkDir ("C:\Users\" & Environ("USERNAME") & "\Desktop\GEAPDATA")
    MkDir ("C:\Users\" & Environ("USERNAME") & "\Desktop\GEAPDATA\Arquivos")
    'MsgBox "Nova pasta criada!"
    End If


    bom e isso ai!


    .................................................................................
    Att, Danilo Reis
    -------------------------------------------------------------------------------------------------------------------------------------------------
    [Você precisa estar registrado e conectado para ver este link.]

    Se alguém não quiser trabalhar, não coma também.
    2 Tessalonicenses 3:10

    infosoft
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 250
    Registrado : 09/07/2012

    Re: Criar diretório em Documentos do Windows 7 através do VBA

    Mensagem  infosoft em Seg 30 Jun 2014, 20:51

    Obrigado daniloreiis, por me mostrar: " & Environ("USERNAME") & ", isso faz abrir a pasta automaticamente...
    O problema era que "Documentos" estava em ingles "Documents"

    ===== CÓDIGO COMPLETO =====
    Private Sub ButPDF_Click()
    On Error Resume Next
    DoCmd.SetWarnings False
    Me.Requery
    Dim blRet As Boolean
    Dim strArquivoCOD2 As String
    Dim strCOD2 As String
    Dim strPrintEtq As String
    Dim strUser As String
    Dim strData As String
    If IsNull(cboRel) Then
    Beep
    Call MsgBox("É necessário escolher um catálogo.", vbOKOnly, "Conversão para arquivo PDF")
    Exit Sub
    End If
    If (cboRel = 2 And IsNull(cboRel)) Then
    Beep
    MsgBox "Para criar um arquivo PDF, é necessário escolher um catálogo." _
    , vbOKOnly, "Conversão para arquivo PDF"
    Exit Sub
    End If

    strCOD2 = Me.cboRel
    strUser = Me.urede
    strData = Me.boxData

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.folderexists("D:\Users\" & Me.urede & "\Documents\GEAPDATA Or D:\Users\" & Me.urede & "\Documents\GEAPDATA\Arquivos") Then
    Else
    MkDir "D:\Users\" & Me.urede & "\Documents\GEAPDATA"
    MkDir "D:\Users\" & Me.urede & "\Documents\GEAPDATA\Arquivos"
    End If
    strArquivoCOD2 = "D:\Users\" & Me.urede & "\Documents\GEAPDATA\Arquivos\" & Me.boxData & "_" & Me.cboRel & ".pdf"
    blRet = ConvertReportToPDF(strCOD2, vbNullString, strArquivoCOD2, False, False, 150, "", "", 0, 1, 0)
    Dim Msg As String
    Msg = MsgBox("Deseja abrir a pasta onde foi criado o arquivo PDF?" _
    , vbYesNo, "Abrir pasta")
    If Msg = vbNo Then
    DoCmd.Close acForm, Me.Name
    Exit Sub
    End If
    If Msg = vbYes Then
    DoCmd.Close acForm, Me.Name
    Shell "explorer.exe D:\Users\" & Environ("USERNAME") & "\Documents\GEAPDATA\Arquivos", vbNormalFocus
    Exit Sub
    End If
    End Sub
    ============================

    No system.zip está: Módulo escrito dentro do TXT (copie o conteúdo e cole num módulo com o mesmo nome) a DLL é para fazer funcionar.

    NO MÓDULO, mude a linha onde está: hLibDynaPDF = "X:\Informática\GEAPDATA\system\DynaPDF.dll"
    para: hLibDynaPDF = "Caminho onde está a sua DLL\DynaPDF.dll"

    Obrigado, Luz e Paz!
    Anexos
    system.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (1.1 Mb) Baixado 11 vez(es)

      Data/hora atual: Sex 09 Dez 2016, 07:42