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

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.

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

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

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

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