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

    Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Compartilhe
    avatar
    diegojacob
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 119
    Registrado : 06/07/2011

    Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Mensagem  diegojacob em Ter 11 Mar 2014, 16:50

    Boa tarde a todos.

    A um tempo atrás eu peguei um exemplo de um Módulo clsAbrirSalvarArquivo.cls, e até hoje ele é bem útil. Porém, devido a migração do Office 2010 64 bits, ele parou de funcionar.

    Fiz algumas pesquisas no Fórum para tentar solucionar os problemas entre versões, para algumas Funções funcionou perfeitamente usando o PtrSafe, já para essa específica, a qual envio em anexo, não consegui fazer funcionar.

    Gostaria de um suporte especializado dos amigos do Forum para solucionar tal problema da Função.

    Outra coisa que gostaria de saber é se haveria alguma Função que ao abrir o FrontEnd, ele executasse tal função, reconhecendo automaticamente Office 32 ou 64 bits, e aplicar as Funções inerentes automaticamente sem ter que editar as Funções uma-a-uma?

    SEGUE ANEXO O EXEMPLO EM 32 BITS.

    Obrigado.
    Anexos
    Exemplo.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (110 Kb) Baixado 10 vez(es)
    avatar
    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3385
    Registrado : 04/04/2010

    Re: Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Mensagem  Avelino Sampaio em Ter 11 Mar 2014, 17:28

    Olá!

    Com o office 2010 vc pode montar funções com este propósito sem precisar de API, o que é ótimo para evitar este problema. Baixe o Maestro do meu site, entre na estrutura e copie o módulo mod_procuraArquivo.

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

    Caso insista com o código do seu exemplo terá que utlizar acondicional #IF. Veja neste meu artigo:

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

    Sucesso!
    avatar
    diegojacob
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 119
    Registrado : 06/07/2011

    Re: Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Mensagem  diegojacob em Ter 11 Mar 2014, 18:04

    Prezado Avelino,
    eu baixei o Maetro conforme indicado, porém ao copiar o Módulo mod_ProcurarArquivo para o banco na versão 32 bits ele ocorre erro em :

    Dim fd As Office.FileDialog

    ! Erro de compilação
    O tipo definido pelo usuário não foi definido.

    Eu apenas depurei o código e ele mostra esse erro.

    Preciso fazer mais algo?

    Obrigado
    avatar
    diegojacob
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 119
    Registrado : 06/07/2011

    Re: Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Mensagem  diegojacob em Qua 12 Mar 2014, 17:15

    Eu encontrei essa função, porém ocorre erro de sintaxe.

    Alguém poderia testar para me ajudar?


    Public Function GetOpenFileName(blnAllowMultiSelect As Boolean, strFiltersDesc As String, strFiltersExt As String, _
    intDefaultFilter As Integer, strDefaultFolder As String, strTitle As String) As String
    'Informações dos argumentos:
    'strFiltersDesc = passar a descrição dos tipos de arquivo separada por pipe. Exemplo:
    '"Arquivos Excel (*.xls,*.xlsx,*.xlsm,*.xlsb)|Arquivos CSV (*.csv)"
    'strFiltersDesc = passar os grupos de extensão dos tipos de arquivo separados por pipe. Exemplo:
    '"*.xls;*.xlsx;*.xlsm;*.xlsb|*.csv"
    'intDefaultFilter: código do filtro padrão, começando por 1.
    'strDefaultFolder: se o valor terminar por "\", entende como pasta padrão. Caso contrário, pasta padrão e início do nome do arquivo.
    Dim dlg As Object
    Dim varArrayFilterDesc As Variant
    Dim varArrayFilterExt As Variant
    Dim intQtFilter As Integer
    Dim i As Integer
    Dim strReturn As String

    On Error GoTo ErrHandler

    Set dlg = Application.FileDialog(3) 'msoFileDialogFilePicker = 3

    'Matriz de descrição de filtro
    varArrayFilterDesc = Split(strFiltersDesc, "|")
    varArrayFilterExt = Split(strFiltersExt, "|")
    If UBound(varArrayFilterDesc) >= UBound(varArrayFilterExt) Then (ERRO**)
    intQtFilter = UBound(varArrayFilterExt)
    Else
    intQtFilter = UBound(varArrayFilterDesc)
    End If

    With dlg
    .AllowMultiSelect = blnAllowMultiSelect
    For i = 0 To intQtFilter
    .Filters.Add varArrayFilterDesc(i), varArrayFilterExt(i)
    Next i
    .FilterIndex = intDefaultFilter
    .InitialFileName = strDefaultFolder
    .Title = strTitle
    .Show
    For i = 1 To .SelectedItems.Count
    strReturn = strReturn & .SelectedItems(i) & ";" (ERRO **)
    Next i
    If Len(strReturn) > 0 Then (ERRO**)
    strReturn = Left(strReturn, Len(strReturn) - 1)
    End If
    End With

    GetOpenFileName = strReturn

    ExitHere:
    Exit Function

    ErrHandler:
    'MsgBox Err.Description & vbCrLf & Err.Number & vbCrLf & Err.Source, vbCritical, "GetOpenFile"
    Err.Raise Err.Number, Err.Source, Err.Description
    Resume ExitHere
    Resume
    End Function

    ERRO EM: (VER ANEXO)
    **If UBound(varArrayFilterDesc) >= UBound(varArrayFilterExt) Then (FICA VERMELHO)
    **strReturn = strReturn & .SelectedItems(i) & ";"
    **If Len(strReturn) > 0 Then

    Anexos
    Erro de compilação Sintaxe .zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (282 Kb) Baixado 2 vez(es)
    avatar
    Avelino Sampaio
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3385
    Registrado : 04/04/2010

    Re: Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Mensagem  Avelino Sampaio em Qua 12 Mar 2014, 17:54

    Ative a referência "MICROSOFT OFFICE 14.0 OBJECT LIBRARY"

    Sucesso!
    avatar
    diegojacob
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 119
    Registrado : 06/07/2011

    Re: Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Mensagem  diegojacob em Qua 12 Mar 2014, 18:54

    Prezado Avelino,
    muito obrigado!

    A Função que copiei do Maestro, funcionou perfeitamente!


    A Função (by Maestro) ficou assim:


    Dim fd As Office.FileDialog
    On Error GoTo trataerro
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
    With .Filters
    .Clear
    .Add "Banco de Dados", "*.accdb", 1
    .Add "Todos", "*.*", 2
    End With
    .Title = "Selecionar Banco de Dados)"
    .AllowMultiSelect = False
    .InitialFileName = "c:\"
    .InitialView = msoFileDialogViewPreview
    If .Show Then
    fncLocalizarArquivo = .SelectedItems(1)
    End If
    End With
    sair:
    Exit Function
    trataerro:
    fncLocalizarArquivo = ""
    Resume sair:
    End Function

    ---------------------------------------------------------------------------

    Public Function fncLocalizarPasta(strTitulo As String)
    Dim fd As Office.FileDialog
    On Error GoTo trataerro
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
    .AllowMultiSelect = False
    .ButtonName = "Selecionar"
    .InitialFileName = "c:\"
    .InitialView = msoFileDialogViewList
    '.Title = "Selecione a pasta de destino"
    .Title = strTítulo
    End With
    If fd.Show = -1 Then
    fncLocalizarPasta = fd.SelectedItems(1)
    End If
    sair:
    Exit Function
    trataerro:
    fncLocalizarPasta = ""
    Resume sair:
    End Function


    ------------------------------------------------------------------------

    Private Sub Search_Click()

    Dim Titulo As String, filtro As String, NovoCaminho As String
    On Error Resume Next
    NovoCaminho = fncLocalizarArquivo
    If NovoCaminho = CaminhoAtual Or NovoCaminho = "" Then
    Me.TxtOrigem = CaminhoAtual
    Else
    Me.TxtOrigem = NovoCaminho
    End If

    End Sub



    Obrigado.
    Diego
    avatar
    diegojacob
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 119
    Registrado : 06/07/2011

    Re: Fazer o Módulo clsAbrirSalvarArquivo.cls funcionar com o Office 32 bits ou 64 bits

    Mensagem  diegojacob em Qua 12 Mar 2014, 18:58

    Prezado Avelino,


    Favor atualizar o staus para [Resolvido], pois cliquei em resolvido, mas o comando não executou a mudança de status.

    Obrigado.
    Diego

      Data/hora atual: Qua 23 Ago 2017, 03:17