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]Caixa de Diálogo para Salvar Arquivo

    Compartilhe
    avatar
    Eloirp
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 181
    Registrado : 14/06/2013

    Caixa de Diálogo para Salvar Arquivo

    Mensagem  Eloirp em Seg Jul 15, 2013 7:38 am

    Estou com dificuldade em abrir uma caixa de diálogo para salvar um arquivo, pois existem muitos exemplos no fórum de como obter o caminho e arquivo para copiar e eu preciso do inverso, será que além pode me dar uma ajuda?

    O código que tenho para o formulário é este abaixo, porém não consigo abrir a caixa de diálogo para definir o caminho  para onde salvar o arquivo em strDestino:

    Private Sub Download_Click()

       If Not Isnull(Me.Caminho) Then

           Dim strOrigem As String
           Dim strDestino As String
           Dim strDestinoFile As String
           
           strOrigem = Me.Caminho ' a origem está salva em uma tabela e o campo Caminho do formulário está atualizado com o mesmo!
           strDestino = ??????
           strDestinoFile = "" & strDestino & "\" & Me.Arquivo & "" ' união de caminho com o nome do arquivo que está no controle Arquivo no formulário!
           
           If Len(Dir(strDestinoFile)) > 0 Then ' verifica se o arquivo já existe antes de salvar!
               If MsgBox("O arquivo já existe em " & strDestino & ", deseja continuar! ", vbYesNo + vbOKOnly, "Sistema Interno ELPER") = vbYes Then
                   FileCopy strOrigem, strDestinoFile
                   MsgBox (" Arquivo salvo com sucesso em " & strDestinoFile & "!  "), vbOKOnly, "Sistema Interno ELPER"
               End If
           Else
               FileCopy strOrigem, strDestinoFile
               MsgBox (" Arquivo salvo com sucesso em " & strDestinoFile & "!  "), vbOKOnly, "Sistema Interno ELPER"
           End If
       End If
    End Sub
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10116
    Registrado : 04/11/2009

    Re: [Resolvido]Caixa de Diálogo para Salvar Arquivo

    Mensagem  JPaulo em Seg Jul 15, 2013 11:08 am

    Veja se ajuda;

    [Você precisa estar registrado e conectado para ver este link.]

    [Você precisa estar registrado e conectado para ver este link.]



    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver este link.]

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Eloirp
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 181
    Registrado : 14/06/2013

    Re: [Resolvido]Caixa de Diálogo para Salvar Arquivo

    Mensagem  Eloirp em Seg Jul 15, 2013 12:30 pm

    Olá JPaulo,

    Muito obrigado pela ajuda!
    Sou iniciando no Access e muita mais em VB, então estou apanhando um pouco...

    O código do link que vc me passou abre a caixa, mas tem que selecionar um arquivo..
    Function AbreJanelaSalvar() As String
    Dim strFicheiros As Object
    'FileDialog(2) = salvar
    'FileDialog(3) = abrir
    Set strFicheiros = Application.FileDialog(2)
    strFicheiros.AllowMultiSelect = True
    strFicheiros.Show
    End Function

    Eu havia adaptado um código do fórum e rodou perfeito em 32 bits, porém quando passei para o micro da empresa que é 64 bits dá Erro de Complicação - O tipo definido pelo usuário não foi definido! e ao depurar abre o módulo destacando em :
    Function BrowseFolderPastaInicial(Title As String, _
    Optional InitialFolder As String = vbNullString, _
    Optional InitialView As Office.MsoFileDialogView = _
    msoFileDialogViewList) As String



    o que usei foi:

    Módulo:
    Function BrowseFolderPastaInicial(Title As String, _
    Optional InitialFolder As String = vbNullString, _
    Optional InitialView As Office.MsoFileDialogView = _
    msoFileDialogViewList) As String
    'função adaptada por Alexandre Neves de função obtida na internet
    Dim V As Variant
    Dim InitFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
       .Title = Title
       .InitialView = InitialView
       If Len(InitialFolder) > 0 Then
           If Dir(InitialFolder, vbDirectory) <> vbNullString Then
               InitFolder = InitialFolder
               If Right(InitFolder, 1) <> "\" Then
                   InitFolder = InitFolder & "\"
               End If
               .InitialFileName = InitFolder
           End If
       End If
       .Show
       On Error Resume Next
       Err.Clear
       V = .SelectedItems(1)
       If Err.Number <> 0 Then
           V = vbNullString
       End If
    End With
    BrowseFolderPastaInicial = CStr(V)
    End Function



    Formulário:
    Private Sub Download_Click()

       If Me.Caminho = "" Then
       Else
           
           Dim strOrigem As String
           Dim strDestino As String
           Dim strDestinoFile As String
           
           strOrigem = Me.Caminho
           strDestino = BrowseFolderPastaInicial ("Escolha uma pasta para salvar o arquivo")
           strDestinoFile = "" & strDestino & "\" & Me.Arquivo & ""
           
           If Len(Dir(strDestinoFile)) > 0 Then
           
               If MsgBox("O arquivo já existe em " & strDestino & ", deseja continuar! ", vbYesNo + vbOKOnly, "Sistema Interno ELPER") = vbYes Then
                   FileCopy strOrigem, strDestinoFile
                   CurrentDb.Execute "INSERT INTO tbl_Arquivo_Anexo_Download (Item,Tipo,NomeArquivo,Destino,User,Data) VALUES ('" & Me.Item & "','" & Me.Tipo & "','" & Me.Arquivo & "','" & strDestinoFile & "','" & getUsuarioAtual() & "','" & Now() & "')"
                   MsgBox (" Arquivo salvo com sucesso em " & strDestinoFile & "!  "), vbOKOnly, "Sistema Interno ELPER"
               
               End If
           Else
               FileCopy strOrigem, strDestinoFile
               CurrentDb.Execute "INSERT INTO tbl_Arquivo_Anexo_Download (Item,Tipo,NomeArquivo,Destino,User,Data) VALUES ('" & Me.Item & "','" & Me.Tipo & "','" & Me.Arquivo & "','" & strDestinoFile & "','" & getUsuarioAtual() & "','" & Now() & "')"
               MsgBox (" Arquivo salvo com sucesso em " & strDestinoFile & "!  "), vbOKOnly, "Sistema Interno ELPER"
           
           End If
       End If
    End Sub



    Se souber me ajudar com o que tem que fazer para este módulo rodar em 64 bits resolve em 100%.


    Última edição por Eloirp em Qua Jul 17, 2013 8:39 am, editado 1 vez(es)
    avatar
    Eloirp
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 181
    Registrado : 14/06/2013

    Re: [Resolvido]Caixa de Diálogo para Salvar Arquivo

    Mensagem  Eloirp em Qua Jul 17, 2013 8:37 am

    Consegui resolver! Valeu pela ajuda JPaulo!

    Usei o método Application.FileDialog() e apenas tive que marcar Microsoft Office 14.0 Object Library nas referências do Access.

    Private Sub Download_Click()

       Dim strOrigem As String
       Dim strDestino As String
       Dim strDestinoFile As String
       Dim fDialog As Office.FileDialog
       Dim varFolder As Variant

       Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

       With fDialog

       .Title = "Selecione uma pasta para salvar o arquivo"
       
       If .Show = True Then
       
           For Each varFolder In .SelectedItems
           
               strOrigem = Me.Caminho
               strDestino = varFolder
               strDestinoFile = "" & strDestino & "\" & Me.Arquivo & ""
                   
               If Len(Dir(strDestinoFile)) > 0 Then
                   
                   If MsgBox("O arquivo já existe em " & strDestino & ", deseja continuar! ", vbYesNo + vbOKOnly, "Sistema Interno ELPER") = vbYes Then
                       FileCopy strOrigem, strDestinoFile
                       CurrentDb.Execute "INSERT INTO tbl_Arquivo_Anexo_D (Item,Tipo,NomeArquivo,Destino,User,Data) VALUES ('" & Parent.Numero & "','" & Me.Tipo & "','" & Me.Arquivo & "','" & strDestinoFile & "','" & getUsuarioAtual() & "','" & Now() & "')"
                       MsgBox (" Arquivo salvo com sucesso em " & strDestinoFile & "!  "), vbOKOnly, "Sistema Interno ELPER"
                       
                   End If
               Else
                   FileCopy strOrigem, strDestinoFile
                   CurrentDb.Execute "INSERT INTO tbl_Arquivo_Anexo_D (Item,Tipo,NomeArquivo,Destino,User,Data) VALUES ('" & Parent.Numero & "','" & Me.Tipo & "','" & Me.Arquivo & "','" & strDestinoFile & "','" & getUsuarioAtual() & "','" & Now() & "')"
                   MsgBox (" Arquivo salvo com sucesso em " & strDestinoFile & "!  "), vbOKOnly, "Sistema Interno ELPER"
                   
               End If
                   
           Next
       
       Else
           MsgBox ("       Ação de salvar cancelada pelo usuário!       "), vbOKOnly, "Sistema Interno ELPER"
       End If
       End With
                   
    End Sub
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 10116
    Registrado : 04/11/2009

    Re: [Resolvido]Caixa de Diálogo para Salvar Arquivo

    Mensagem  JPaulo em Qua Jul 17, 2013 8:43 am

    Fico feliz,

    Obrigado pelo retorno o forum agradece.


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver este link.]

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]

    glenioluiz
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 25
    Registrado : 20/03/2017

    Menu suspenso

    Mensagem  glenioluiz em Ter Jun 05, 2018 11:08 am

    Boa tarde

    Eu baixei há algum tempo o Menu Suspenso que é parte do sistema Elper.
    Estou adaptando para um aplicativo que eu desenvolvi, mas não achei mais nenhum informação sobre o sistema.
    No menu há uma opção para backup, mas não abre nenhuma rotina de backup.
    Poderiam publicar alguma coisa a respeito pois o menu pronto é muito bom, mas a parte de backup ficou devendo

    Obrigado.

    ps: na imagem em anexo pode-se visualizar

      Data/hora atual: Ter Set 25, 2018 7:29 pm