MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

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

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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


3 participantes

    [Resolvido]Abrir a a Pasta Criada

    avatar
    brunobpr
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 13
    Registrado : 11/05/2012

    [Resolvido]Abrir a a Pasta Criada Empty [Resolvido]Abrir a a Pasta Criada

    Mensagem  brunobpr 15/11/2014, 01:37

    Pessoal, por aqui achei uma função que cria uma pasta em determinado local,porem gostaria de complementar e não achei aqui que: após a criação da tabela eu conseguisse ve-la, ou seja ver os documentos que estão salvos nela( que podem ser *.txt,/.doc etc

    abaixo o código que utilizei ate o momento, aguardo ajuda de vocês

    Dim FSO As Object
    Dim strlocal, pasta As String
    strlocal = CurrentProject.Path & "\Empresas\" & Me.TXTCNPJ.Value & "-" & Me.NOME & "\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Len(Dir(strlocal, vbDirectory)) > 0 Then ' verifica se ja existe
    Else
    MkDir strlocal ' se nao existir cria
    MsgBox ("Pasta da Empresa criada com sucesso !!!")
    End If
    Dim Msg, Style, Response
    Msg = " Deseja abrir a pasta?"
    Style = vbYesNo + vbInformation + vbDefaultButton2
    Response = MsgBox(Msg, Style)
    If Response = vbYes Then
    strlocal = OpenCommDlg()
    End If

    /////modulo

    Option Compare Database
    Option Explicit

    Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    End Type
    Declare Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OPENFILENAME As tagOPENFILENAME) As Long
    '
    Dim OPENFILENAME As tagOPENFILENAME
    Public Const OFN_READONLY = &H1
    Public Const OFN_OVERWRITEPROMPT = &H2
    Public Const OFN_HIDEREADONLY = &H4
    Public Const OFN_NOCHANGEDIR = &H8
    Public Const OFN_SHOWHELP = &H10
    Public Const OFN_ENABLEHOOK = &H20
    Public Const OFN_ENABLETEMPLATE = &H40
    Public Const OFN_ENABLETEMPLATEHANDLE = &H80
    Public Const OFN_NOVALIDATE = &H100
    Public Const OFN_ALLOWMULTISELECT = &H200
    Public Const OFN_EXTENSIONDIFFERENT = &H400
    Public Const OFN_PATHMUSTEXIST = &H800
    Public Const OFN_FILEMUSTEXIST = &H1000
    Public Const OFN_CREATEPROMPT = &H2000
    Public Const OFN_SHAREAWARE = &H4000
    Public Const OFN_NOREADONLYRETURN = &H8000
    Public Const OFN_NOTESTFILECREATE = &H10000
    Public Const OFN_NONETWORKBUTTON = &H20000
    Public Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules
    Public Const OFN_EXPLORER = &H80000 ' new look commdlg
    Public Const OFN_NODEREFERENCELINKS = &H100000
    Public Const OFN_LONGNAMES = &H200000 ' force long names for 3.x modules

    Public Const OFN_SHAREFALLTHROUGH = 2
    Public Const OFN_SHARENOWARN = 1
    Public Const OFN_SHAREWARN = 0

    '
    '-------------------------------------------------------
    ' Open Common Dialog Function
    '-------------------------------------------------------
    Function OpenCommDlg()
    Dim message$, Filter$, FileName$, FileTitle$, DefExt$
    Dim Title$, szCurDir$, APIResults&
    '
    Filter$ = "Imagens (GIF,PCX,BMP,JPG)" & Chr$(0) & "*.BMP;*.GIF;*.PCX;*.JPG;" & Chr$(0) & _
    "Todos os ficheiros (*.*)" & Chr(0) & "*.*;" & Chr(0)
    Filter$ = Filter$ & Chr$(0)
    '
    FileName$ = Chr$(0) & Space$(255) & Chr$(0)
    FileTitle$ = Space$(255) & Chr$(0)
    '* Give the dialog a caption title.
    Title$ = "Selecionar imagem" & Chr$(0)
    '
    DefExt$ = "BMP" & Chr$(0) ' extensión por defecto
    szCurDir$ = CurDir$ & Chr$(0) ' directorio por defecto, el actual
    '* Set up the data structure before you call the GetOpenFileName
    OPENFILENAME.lStructSize = Len(OPENFILENAME)
    'If the OpenFile Dialog box is linked to a form use this line.
    'It will pass the forms window handle.
    OPENFILENAME.hwndOwner = Screen.ActiveForm.hwnd
    'If the OpenFile Dialog box is not linked to any form use this line.
    'It will pass a null pointer.
    'OPENFILENAME.hwndOwner = 0&
    OPENFILENAME.lpstrFilter = Filter$
    OPENFILENAME.nFilterIndex = 1
    OPENFILENAME.lpstrFile = FileName$
    OPENFILENAME.nMaxFile = Len(FileName$)
    OPENFILENAME.lpstrFileTitle = FileTitle$
    OPENFILENAME.nMaxFileTitle = Len(FileTitle$)
    OPENFILENAME.lpstrTitle = Title$
    OPENFILENAME.flags = OFN_FILEMUSTEXIST Or OFN_READONLY Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
    OPENFILENAME.lpstrDefExt = DefExt$
    OPENFILENAME.hInstance = 0
    OPENFILENAME.lpstrCustomFilter = String(255, 0)
    OPENFILENAME.nMaxCustFilter = 255
    OPENFILENAME.lpstrInitialDir = (strlocal)
    OPENFILENAME.nFileOffset = 0
    OPENFILENAME.nFileExtension = 0
    OPENFILENAME.lCustData = 0
    OPENFILENAME.lpfnHook = 0
    OPENFILENAME.lpTemplateName = 0
    If apiGetOpenFileName(OPENFILENAME) <> 0 Then
    OpenCommDlg = Left$(OPENFILENAME.lpstrFile, InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1)
    Else
    OpenCommDlg = ""
    End If
    End Function


    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3873
    Registrado : 21/04/2011

    [Resolvido]Abrir a a Pasta Criada Empty Re: [Resolvido]Abrir a a Pasta Criada

    Mensagem  Marcelo David 15/11/2014, 01:45

    Que código gigante para fazer uma tarefa tão simples!
    Mas se está lhe atendendo, ótimo!

    Para abrir uma pasta ou um arquivo ou um site:

    Application.FollowHyperlink "Caminho da pasta ou do arquivo com extençao ou endereço do site", , True


    Última edição por Marcelo David em 15/11/2014, 01:46, editado 1 vez(es) (Motivo da edição : Para fechar as aspas do código)


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Conheça meu canal no Youtube e se inscreva.
    [Resolvido]Abrir a a Pasta Criada Marcel11
    avatar
    brunobpr
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 13
    Registrado : 11/05/2012

    [Resolvido]Abrir a a Pasta Criada Empty Re: [Resolvido]Abrir a a Pasta Criada

    Mensagem  brunobpr 15/11/2014, 11:44

    Marcelo

    noooosssaaa me ajudou como era facil e eu complicando tudo

    agradeco
    avatar
    brunobpr
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 13
    Registrado : 11/05/2012

    [Resolvido]Abrir a a Pasta Criada Empty Re: [Resolvido]Abrir a a Pasta Criada

    Mensagem  brunobpr 15/11/2014, 11:45

    resolvido
    Noobezinho
    Noobezinho
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 4140
    Registrado : 29/06/2012

    [Resolvido]Abrir a a Pasta Criada Empty Re: [Resolvido]Abrir a a Pasta Criada

    Mensagem  Noobezinho 15/11/2014, 12:10

    Bruno

    Aqui está um função para verificar se existe uma pasta, caso não tenha a cria.

    Código:

    Function VerificaPasta(txtPasta As String)

    If Len(Dir(txtPasta, vbDirectory)) = 0 Then
       MkDir txtPasta
    End If
    End Function

    uso:
    Call VerificaPasta(CurrentProject.Path & "\MinhaPasta\")

    Editando, não recebi notificação e nem vi esses últimos posts, nem que estava resolvido.
    Mas vou deixar o código para futuras dúvidas.


    Abraços

    Noob


    .................................................................................
    A pergunta que não quer calar:
    Por quê quando alguém vem pedir ajuda e conforme o caso pedimos
    para enviar parte do projeto, não temos mais continuidade do tópico?  
    Crê que temos bolas de cristal ou está com medo que "roubemos"  a
    idéia/projeto dele?  Twisted Evil
    Se é tão bom assim...


    Ajude a ser ajudado:
    Seja objetivo na dúvida, dê os detalhes do que precisa, sem rodeios.
    Quando anexar teu projeto, diga onde está o problema, ganhamos mais tempo
    sem precisar procurar o mesmo.
    Marcelo David
    Marcelo David
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3873
    Registrado : 21/04/2011

    [Resolvido]Abrir a a Pasta Criada Empty Re: [Resolvido]Abrir a a Pasta Criada

    Mensagem  Marcelo David 17/11/2014, 00:25

    Grato meu amigo pelo retorno!


    .................................................................................
    Aprenda como criar formulário desacoplado.
    Conheça meu canal no Youtube e se inscreva.
    [Resolvido]Abrir a a Pasta Criada Marcel11

    Conteúdo patrocinado


    [Resolvido]Abrir a a Pasta Criada Empty Re: [Resolvido]Abrir a a Pasta Criada

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 29/4/2024, 09:34