[Resolvido]Caixa de dialogo (Abrir arquivo ou Salvar como...)

Estou tendo um problema com as caixas de dialogo no sistema 64 bits, li o artigo do Avelino, estou agora procurando no site da microsoft, fiz algumas alterações mas não obtive sucesso. Sendo que no sistema 32 bits funciona perfeitamente.
Queria saber se alguém teve este mesmo problema e resolveu?
Segue código abaixo para maiores detalhes.

Este código é para abrir a caixa de dialogo (Selecione o arquivo)

Código:


Private Sub cmdProcurar_Click()
    Dim strPath As String
    Dim fso As New FileSystemObject
    Dim arq As File
    Dim ExcWork  As Excel.Workbook
    Dim wsheet As Worksheet
    strPath = cAbrirArq.GetOpenFile(Me.hwnd, "Selecione um arquivo do Excel")
    If Len(strPath) > 0 Then
        Me.txtPath = strPath
    Set arq = fso.GetFile(txtPath.Value)
    With arq
        Me.Text1.Value = .ShortName
    Set ExcWork = Workbooks.Open(Me.txtPath)
    For Each wsheet In ActiveWorkbook.Worksheets
        Me.cboSheets.AddItem wsheet.Name
        Me.cboSheets.enabled = True
    Next
    End With
    End If
End Sub


Este código foi o que eu alterei para ver se dava certo, mais nada ainda.
Como podem ver este código é nosso conhecido, ou seja, funciona em 32 bits, mas não em 64 bits

Código:


Option Compare Database
Option Explicit

Private Type OPENFILENAME
    lStructSize As Long 'O tamanho em bytes da estrutura.
    hwndOwner As LongPtr 'Handle da janela abrindo a caixa de diálogo.
    hInstance As LongPtr 'Handle do bloco de memória usado pelo template. O valor 0 significa a caixa de diálogo padrão.
    lpstrFilter As String 'As entradas da caixa de combinação File Type.
                          'O formato da string é: "nome da extensão" & vbNullChar
                          '& "máscara" & vbNullChar ... para quantos tipos quiser,
                          'onde o nome da extensão é o texto que aparece na lista e "máscara" é o tipo de arquivo (extensão).
                          'A string deve terminar com um duplo vbNullChar.
    lpstrCustomFilter As String 'Similar a lpstrFilter, mas contém apenas um par de file type name/mask que especifica um file type definido pelo usuário. Se não usado, defina como uma string vazia ("").
    nMaxCustFilter As Long 'Tamanho em bytes de lpstrCustomFilter.
    nFilterIndex As Long 'Índice 1, 2 etc para lpstrFilter.
    lpstrFile As String 'Defina como uma série de espaços em branco.
    nMaxFile As Long 'O comprimento em caracteres de lpstrFile.
    lpstrFileTitle As String 'Muito similar a lpstrFile, mas apenas recebe o filename do arquivo selecionado.
    nMaxFileTitle As Long 'O comprimento em caracteres de lpstrFileTitle.
    lpstrInitialDir As String 'O diretório default para pesquisar.
    lpstrTitle As String 'Texto que aparece na barra de título da caixa.
    flags As Long 'Flags de configuração da caixa.
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
End Type

Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As LongPtr

Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As LongPtr

Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000

Function GetOpenFile(ByVal hwnd As Long, _
 ByVal strDialogTitle As String) As String
    Dim OFN As OPENFILENAME
    Dim varFileName As Variant 'Nome do arquivo selecionado.
    OFN = SetOFN("OpenFile", hwnd, strDialogTitle)
    If GetOpenFileName(OFN) Then
        varFileName = Left(OFN.lpstrFile, _
            InStr(OFN.lpstrFile, vbNullChar) - 1)
        GetOpenFile = varFileName
    Else
        GetOpenFile = ""
    End If
End Function

Function SaveFileName(ByVal hwnd As Long, _
 ByVal strDialogTitle As String) As String
    Dim OFN As OPENFILENAME
    Dim varFileName As Variant 'Nome do arquivo selecionado.
    OFN = SetOFN("SaveAs", hwnd, strDialogTitle)
    If GetSaveFileName(OFN) Then
        varFileName = Left(OFN.lpstrFile, _
            InStr(OFN.lpstrFile, vbNullChar) - 1)
        SaveFileName = varFileName
    Else
        SaveFileName = ""
    End If
End Function

Private Function SetOFN(strTipo As String, _
    hwnd As Long, strDialogTitle As String) As OPENFILENAME
    Dim lngFlags As Long 'flags da estrutura.
    Select Case strTipo
    Case "OpenFile"
        lngFlags = OFN_FILEMUSTEXIST Or _
                  OFN_HIDEREADONLY Or OFN_NOCHANGEDIR
    Case "SaveAs"
        lngFlags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY _
                  Or OFN_OVERWRITEPROMPT
    End Select
    With SetOFN
        .lStructSize = Len(SetOFN) 'Tamanho da estrutura.
        .hwndOwner = hwnd 'Handle da janela abrindo a caixa de diálogo.
        .lpstrFilter = "Planilha do Excel (*.xls)" _
            & vbNullChar & "*.xls" & vbNullChar & vbNullChar
        .lpstrDefExt = "xls"  'Extensão default do arquivo.
        .nMaxCustFilter = 0
        .flags = lngFlags
        .lpstrInitialDir = CurDir & vbNullChar 'Diretório inicial.
        .lpstrTitle = strDialogTitle & vbNullChar 'Título da caixa de diálogo.
        .lpstrFile = Space$(256) & vbNullChar  'Inicializa buffer que recebe o caminho e nome do arquivo.
        .lpstrFileTitle = Space$(256) & vbNullChar 'O mesmo para o nome do arquivo.
        .nMaxFile = Len(.lpstrFile)  'Comprimento máximo de lpstrFile.
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .nFilterIndex = 1
    End With
End Function



Abraços a todos os amigos colaboradores.

Boas Walter... baixe o sistema SysBase no repositório.. no painel de navegação tem no módulo Mover arquivos... Tem 4 módulos.. copie-os no teu sistema... No form frmCopiarMover.. tem como se utiliza....

Cumprimentos.

Ok, PILOTO
Estarei vendo e baixando o aplicativo.
Logo darei as resposta se deu certo ou não.
Abraços

Ok, aguardamos...

Meu amigo PILOTO,
vi seu arquivo no repositório, mas ele não funciona em 64 bits. Aquele modulo não funciona.
Fiz uma fusão de códigos (seu e do avelino) e consegui este resultado que funciona em 64 bits e creio que em 32 bits tambem.

Segue link para estudos sobre a linha de comando abaixo.
Office.FileDialog

Segue a função criada pelo Avelino:

Código:

Public Function fncLocalizarArquivoXLS()
Dim fdxls As Office.FileDialog  'essa linha que faz abrir a caixa de dialogo
On Error GoTo TrataErro
Set fdxls = Application.FileDialog(msoFileDialogOpen)
With fdxls
    With .Filters
        .Clear
        .Add "Planilha do Excel", "*.xls", 1
        .Add "Todos", "*.*", 2
    End With
    .Title = "Selecione a tabela para importar"
    .AllowMultiSelect = False
    .InitialFileName = "c:\wRepresentante\tabela"
    .InitialView = msoFileDialogViewPreview
    If .Show Then
        fncLocalizarArquivoXLS = .SelectedItems(1)
    End If
End With
Sair:
    Exit Function
TrataErro:
    fncLocalizarArquivoXLS = ""
    Resume Sair:
End Function

Segue a mescla do seu código com o do Avelino

Código:

Private Sub cmdProcurar_Click()
Dim Titulo As String, filtro As String, NovoCaminhoxls As String, StrAqruivo As String
On Error Resume Next
    NovoCaminhoxls = fncLocalizarArquivoXLS
    If NovoCaminhoxls = CaminhoAtual Or NovoCaminhoxls = "" Then
        Me!Path_0 = CaminhoAtualxls
    Else
        Me!Path_0 = NovoCaminhoxls
    End If
    strArquivo = Mid(NovoCaminhoxls, InStrRev(NovoCaminhoxls, "\") + 1)
    Me.txtPath = NovoCaminhoxls
    Me.Text1 = strArquivo
End Sub

Boas Walter,,,, Eu tinha feito algo neste usentido.. não me lembro se te postei...

Estou aqui procurando o que fiz pra ti... Ma não estou encontrando.. mas sei que fiz...
Acho que nem cheguei a te enviar ou tive um "Dejavu"   Fiquei intrigado por isto agora pois em minhas memórias até tinha lhe enviado a solução.. mas agora que vi sua resposta não a encontro... vai saber!!!

O Fórum agradece o retorno.

Cumprimentos.

Segue link da sua ajuda.

O Fórum agradece o Retorno.