Verknüpfte Tabellen

Es ist eine feine Sache, wenn man Quelldaten, die sich immer wieder ändern, nicht jedesmal importieren muss, sondern einfach als Tabelle verknüft. Das funktioniert auch sehr gut, wenn die Datei vorformatiert ist. Also Excel oder Access bspw. als Quelle dient. Hat man aber eine csv oder txt Datei, ist das ganze nicht mehr ganz so einfach, denn diese Verknüpfungen lassen sich nicht so ohne weiteres über den Tabellenverknüpfungsmanager aktualisieren. Hier gibt es nur 2 Wege mir bekannte Wege:

  1. Man verknüpft immer wieder neu, das ist aber schon nervig, auch wenn man eine Spec dafür hat. Man muss sich ja doch jedesmal durch klicken.
  2. Man erledigt diese Aufgabe per Makro (wie auch sonst) :)
Private Sub Befehl1_Click()
    dateipfad = DateiOeffnen("Datei wählen", _
         "Text-Dateien" & Chr$(0) & "IMPDATEN*.csv", , _
         "C:\DATEN\TRANS_DATEN_IN\WP")
    If dateipfad <> "" Then
        DoCmd.DeleteObject acTable, "IMP_AKT_MON" #
        DoCmd.TransferText acLinkDelim, "IMP_Verknüpfen", "IMP_AKT_MON", dateipfad, True, ""
        'Format: TransferText(Transfertyp, Spezifikationsname, Tabellenname, Dateiname, BesitztFeldnamen, HTML-Tabellenname, Codepage)
    Else
        MsgBox "Nix gewählt."
    End If
End Sub

Das funktioniert ganz wunderbar.
Zuerst wird die alte Verknüpfung gelöscht und dann wird mittels Spezifikation die Verknüpfung neu gemacht. Arbeitet man mit einer schema.ini, läßt man den Spzifikationsnamen einfach leer.

Nur zu dumm, dass VBA für Access nicht von Haus aus den Datei-Öffnen-Dialog anbietet.
Dieser muss erst speziell eingebunden werden. Hier eine Lösung aus dem iNet, leider habe ich mir die Quelle nicht aufgeschrieben. Es klappt aber hervorragend. Ich habe diese Lösung schon seit geraumer Zeit in Nutzung.

Option Compare Database
Option Explicit
 
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath$) As Long
 
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
    "GetSaveFileNameA" (pSavefilename As SAVEFILENAME) As Long
 
Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iTmage As Long
End Type
 
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter 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
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type
 
Private Type SAVEFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter 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
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type
 
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_READONLY = &H1
Public Const OFN_HIDEREADONLY = &H4
Public Const BIF_RETURNONLYFSDIRS = &H1
 
Public Function VerzeichnisWählen(Title$, XHwnd As Long) As String
    Dim x As Long, BInfo As BROWSEINFO, dwIList As Long
    Dim szPath$, wPos%
 
    With BInfo
        .hOwner = XHwnd
        .lpszTitle = Title
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    dwIList = SHBrowseForFolder(BInfo)
    szPath = Space$(512)
    x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    If x Then
        wPos = InStr(szPath, Chr(0))
        VerzeichnisWählen = Left$(szPath, wPos - 1)
      Else
        VerzeichnisWählen = " "
    End If
End Function
 
Public Function DateiOeffnen(Optional Titel, Optional Filter, _
                             Optional DefExtension, Optional Aktdir) As String
    Dim strDateiName$, strDlgTitel$, strFilter$
    Dim strDefExtension$, strAktDir$, strNull$
    Dim OpenDlg As OPENFILENAME
 
    strNull = Chr$(0)
    strDateiName = String$(512, 0)
    If IsMissing(Titel) Then
        strDlgTitel = "Datei öffnen" & strNull
      Else
        strDlgTitel = Titel & strNull
    End If
    If IsMissing(Filter) Then
        strFilter = "Alle Dateien" & strNull & "*.*" & strNull & strNull
      Else
        strFilter = Filter
    End If
    If IsMissing(DefExtension) Then
        strDefExtension = strNull
      Else
        strDefExtension = DefExtension & strNull
    End If
    If IsMissing(Aktdir) Then
        strAktDir = CurDir$ & strNull
      Else
        strAktDir = Aktdir & strNull
    End If
    With OpenDlg
        .lStructSize = Len(OpenDlg)
'        .hwndOwner = Screen.ActiveForm.Hwnd
        .lpstrFilter = strFilter
        .nFilterIndex = 1
        .lpstrFile = strDateiName
        .nMaxFile = Len(strDateiName)
        .lpstrInitialDir = strAktDir
        .lpstrTitle = strDlgTitel
        .Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
        .lpstrDefExt = strDefExtension
        If GetOpenFileName(OpenDlg) <> 0 Then
            DateiOeffnen = Left$(.lpstrFile, InStr(.lpstrFile, strNull) - 1)
          Else
            DateiOeffnen = " "
        End If
    End With
End Function
 
Public Function DateiSpeichern(Optional Titel, Optional Filter, _
                               Optional DefExtension, Optional Aktdir) _
                              As String
    Dim strDateiName$, strDlgTitel$, strFilter$
    Dim strDefExtension$, strAktDir$, strNull$
    Dim SaveDlg As SAVEFILENAME
 
    strNull = Chr$(0)
    strDateiName = String$(512, 0)
    If IsMissing(Titel) Then
        strDlgTitel = "Datei öffnen" & strNull
      Else
        strDlgTitel = Titel & strNull
    End If
    If IsMissing(Filter) Then
        strFilter = "Alle Dateien" & strNull & "*.*" & strNull & strNull
      Else
        strFilter = Filter
    End If
    If IsMissing(DefExtension) Then
        strDefExtension = strNull
      Else
        strDefExtension = DefExtension & strNull
    End If
    If IsMissing(Aktdir) Then
        strAktDir = CurDir$ & strNull
      Else
        strAktDir = Aktdir & strNull
    End If
    With SaveDlg
        .lStructSize = Len(SaveDlg)
        .hwndOwner = Screen.ActiveForm.Hwnd
        .lpstrFilter = strFilter
        .nFilterIndex = 1
        .lpstrFile = strDateiName
        .nMaxFile = Len(strDateiName)
        .lpstrInitialDir = strAktDir
        .lpstrTitle = strDlgTitel
        .Flags = OFN_HIDEREADONLY
        .lpstrDefExt = strDefExtension
        If GetSaveFileName(SaveDlg) <> 0 Then
            DateiSpeichern = Left$(.lpstrFile, InStr(.lpstrFile, strNull) - 1)
          Else
            DateiSpeichern = " "
        End If
    End With
End Function

Ich habe diese Funktionen einfach in ein neues Modul kopiert.

Schreib was...

Bitte rechnen Sie 6 plus 1.