Importar dados de outro arquivo

[Rogério Nunes]

Olá!

Quero importar tabelas de outro banco de dados, cujo endereço e/ou nome não sejam fixos: Por exemplo, hoje , quero importar as tabelas 1 e 2 do arquivo CASA, amanhã quero importar somente a tabela 2 do arquivo TRABALHO. Como faço para que o access pergunte onde está o arquivo a ser importado? (Abriria , por exempo, a árvore de diretórios para eu selecionar o local e nome do arquivo). E como fazer para, depois que eu informar o local do arquivo, ele trazer as tabelas que eu selecione?

Obrigado.

[MrMALJ]

Crie um módulo com esse código

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type MSA_OPENFILENAME
' Seqüência de filtro usada para os filtros do diálogo Abrir.
' Usa MSA_CriarSeqüênciaDeFiltro() para criar isso.
' Padrão = Todos os Arquivos, *.*
    strFiltro As String
' Filtro inicial a exibir.
' Padrão = 1
    lngÍndiceFiltro As Long
' Diretório inicial no qual abrir o diálogo.
' Padrão = Diretório de trabalho atual.
    strDirInicial As String
' Nome de arquivo inicial com o qual preencher o diálogo.
' Padrão = "".
    strArqInicial As String
    strTítuloDoDiálogo As String
' Extensão padrão para anexar ao arquivo se o usuário não especificar uma.
' Padrão = Valores do Sistema (Abrir Arquivo, Salvar Arquivo).
    strExtensãoPadrão As String
' Sinalizadores (consulte a lista de constantes) a serem usados.
' Padrão = sem sinalizadores.
    lngSinalizadores As Long
' Caminho completo do arquivo escolhido. Quando a caixa de diálogo Arquivo
' Abrir é apresentada e o usuário escolhe um arquivo não existente, somente
' o texto da caixa "Nome do arquivo" é retornado.
    strCaminhoCompletoRetornado As String
' Nome do arquivo escolhido.
    strNomeDeArquivoRetornado As String
' Deslocamento no caminho completo (strCaminhoCompletoRetornado)
' onde o nome do arquivo (strNomeDeArquivoRetornado) começa.
    intDeslocamentoDoArquivo As Integer
' Deslocamento no caminho completo (strCaminhoCompletoRetornado)
' onde começa a extensão do arquivo.
    intExtensãoDoArquivo As Integer
End Type

Const ALLFILES = "Todos os arquivos"

Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As Long
    nMaxCustrFilter 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
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10
Function localizarArquivo(strCaminhoDeLocalização) As String
' Exibe a caixa de diálogo Abrir para que o usuário localize o
' banco de dados BdLab. Retorna o caminho completo para o BdLab.

    Dim msaof As MSA_OPENFILENAME

' Define opções para a caixa de diálogo.
    msaof.strTítuloDoDiálogo = "Selecione o arquivo."
    msaof.strDirInicial = strCaminhoDeLocalização
    msaof.strFiltro = MSA_CriarSeqüênciaDeFiltro("Todos", "*.*")

' Chama a rotina do diálogo Abrir.
    MSA_ObterAbrirNomeArq msaof

' Retorna o caminho e o nome de arquivo.
    localizarArquivo = Trim(msaof.strCaminhoCompletoRetornado)

End Function
Function MSA_CriarSeqüênciaDeFiltro(ParamArray varFilt() As Variant) As String
' Cria uma seqüência de filtro a partir dos argumentos passados.
' Retorna "" se nenhum argumento for passado.
' Espera um número par de argumentos (nome do filtro, extensão),
' mas se um número ímpar de argumentos for passado, anexa *.*

    Dim strFiltro As String
    Dim intRet As Integer
    Dim intNúm As Integer

    intNúm = UBound(varFilt)
    If (intNúm <> -1) Then
        For intRet = 0 To intNúm
            strFiltro = strFiltro & varFilt(intRet) & vbNullChar
        Next
        If intNúm Mod 2 = 0 Then
            strFiltro = strFiltro & "*.*" & vbNullChar
        End If
        strFiltro = strFiltro & vbNullChar
    Else
        strFiltro = ""
    End If

    MSA_CriarSeqüênciaDeFiltro = strFiltro
End Function

Function MSA_ConverterSeqüênciaDeFiltro(strFiltroEnt As String) As String
' Cria uma seqüência de filtro a partir de uma seqüência separada por barras ("|").
' A seqüência deve consistir em pares filtro|extensão, como "Access Databases|*.mdb|All Files|*.*"
' Se não houver extensões para o último par de filtro, *.* será adicionado.
' Este código ignora quaisquer seqüências vazias, ou seja, pares "||".
' Retorna "" quando a seqüência passada está vazia.

    Dim strFiltro As String
    Dim intNúm As Integer, intPos As Integer, intÚltPos As Integer

    strFiltro = ""
    intNúm = 0
    intPos = 1
    intÚltPos = 1

' Adiciona seqüências enquanto encontra barras.
' Ignora quaisquer seqüências vazias (não admitidas).
    Do
        intPos = InStr(intÚltPos, strFiltroEnt, "|")
        If (intPos > intÚltPos) Then
            strFiltro = strFiltro & Mid(strFiltroEnt, intÚltPos, intPos - intÚltPos) & vbNullChar
            intNúm = intNúm + 1
            intÚltPos = intPos + 1
        ElseIf (intPos = intÚltPos) Then
            intÚltPos = intPos + 1
        End If
    Loop Until (intPos = 0)

' Obtém a última seqüência se ela existir (assumindo
' que strFiltroEnt não termina em barra).
    intPos = Len(strFiltroEnt)
    If (intPos >= intÚltPos) Then
        strFiltro = strFiltro & Mid(strFiltroEnt, intÚltPos, intPos - intÚltPos + 1) & vbNullChar
        intNúm = intNúm + 1
    End If

' Adiciona *.* se não houver extensão para a última seqüência.
    If intNúm Mod 2 = 1 Then
        strFiltro = strFiltro & "*.*" & vbNullChar
    End If

' Adiciona NULL de terminação se temos algum filtro.
    If strFiltro <> "" Then
        strFiltro = strFiltro & vbNullChar
    End If

    MSA_ConverterSeqüênciaDeFiltro = strFiltro
End Function

Private Function MSA_ObterSalvarNomeArq(msaof As MSA_OPENFILENAME) As Integer
' Abre o diálogo de salvar arquivo.

    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_para_OF msaof, of
    of.flags = of.flags Or OFN_HIDEREADONLY
    intRet = GetSaveFileName(of)
    If intRet Then
        OF_para_MSAOF of, msaof
    End If
    MSA_ObterSalvarNomeArq = intRet
End Function

Function MSA_SimplesObterSalvarNomeArq() As String
' Abre o diálogo de salvar arquivo com valores padrões.

    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strRet As String

    intRet = MSA_ObterSalvarNomeArq(msaof)
    If intRet Then
        strRet = msaof.strCaminhoCompletoRetornado
    End If

    MSA_SimplesObterSalvarNomeArq = strRet
End Function

Private Function MSA_ObterAbrirNomeArq(msaof As MSA_OPENFILENAME) As Integer
' Abre o diálogo Abrir.

    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_para_OF msaof, of
    intRet = GetOpenFileName(of)
    If intRet Then
        OF_para_MSAOF of, msaof
    End If
    MSA_ObterAbrirNomeArq = intRet
End Function

Function MSA_SimplesObterAbrirNomeArq() As String
' Abre o diálogo Abrir com valores padrões.

    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strRet As String

    intRet = MSA_ObterAbrirNomeArq(msaof)
    If intRet Then
        strRet = msaof.strCaminhoCompletoRetornado
    End If

    MSA_SimplesObterAbrirNomeArq = strRet
End Function

Private Sub OF_para_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' Esta sub converte da estrutura Win32 para a estrutura do Microsoft Access.

    msaof.strCaminhoCompletoRetornado = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
    msaof.strNomeDeArquivoRetornado = of.lpstrFileTitle
    msaof.intDeslocamentoDoArquivo = of.nFileOffset
    msaof.intExtensãoDoArquivo = of.nFileExtension
End Sub

Private Sub MSAOF_para_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' Esta sub converte da estrutura do Microsoft Access para a estrutura Win32.

    Dim strArquivo As String * 512

' Inicializa algumas partes da estrutura.
    of.hwndOwner = Application.hWndAccessApp
    of.hInstance = 0
    of.lpstrCustomFilter = 0
    of.nMaxCustrFilter = 0
    of.lpfnHook = 0
    of.lpTemplateName = 0
    of.lCustrData = 0

    If msaof.strFiltro = "" Then
        of.lpstrFilter = MSA_CriarSeqüênciaDeFiltro(ALLFILES)
    Else
        of.lpstrFilter = msaof.strFiltro
    End If
    of.nFilterIndex = msaof.lngÍndiceFiltro

    of.lpstrFile = msaof.strArqInicial & String(512 - Len(msaof.strArqInicial), 0)
    of.nMaxFile = 511

    of.lpstrFileTitle = String(512, 0)
    of.nMaxFileTitle = 511

    of.lpstrTitle = msaof.strTítuloDoDiálogo

    of.lpstrInitialDir = msaof.strDirInicial

    of.lpstrDefExt = msaof.strExtensãoPadrão

    of.flags = msaof.lngSinalizadores

    of.lStructSize = Len(of)
End Sub

e em outro módulo:

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Const BIF_RETURNONLYFSDIRS = &H1

Public Function BrowseFolder(szDialogTitle As String) As String
    Dim X As Long, bi As BROWSEINFO, dwIList As Long
    Dim szPath As String, wPos As Integer

    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

Crie uma caixa de texto não acoplada no seu form chamada arqBusca e um botão com o seguinte código no seu evento ao clicar:

Dim tTt, cCc As Variant
    If Me.arqBusca = "" Or IsNull(Me.arqBusca) Then
        tTt = "C:\"
    Else
        cCc = Len(Me.arqBusca)
        Do
            tTt = Left(Me.arqBusca, cCc)
            cCc = cCc - 1
        Loop Until (Right(tTt, 1) <> "\")
    End If
    Me.arqBusca.Value = localizarArquivo(tTt)

Bom uso esse código para buscar arquivos TXT diversos para extração de seus dados num determinado BD acredito que você possa utilizar no seu.