Access Runtime und Filedialog

b00GI · 27. Juli 2007

Guten morgen allerseits,

Ich will in einer Datenbank eine Datei per Filedialog auswählen, was auch in ACC 2003 gut funktioniert.

Nun will ich diese Datenbank an die Benutzer verteilen, welche aber nur die Access Runtime 2000 benutzen.
Die Datenbank selber ist in Access 2000 format erstellt.

Beim Aufruf des Filedialoges bekomme ich nun einen Laufzeitfehler, und die Datenbank wird geschlossen.

Hab schon ge

't aber nichts gefunden...

kann mir jemand helfen dieses Problem zu beseitigen?:suspekt:

Vielen dank schonmal im vorraus

b00GI

larryson · 27. Juli 2007

Ich hoffe es ist nicht allzu dringend, aber montag könnte ich dazu was posten, habs leider an der arbeit auf dem rechner.

ich importiere damit per filedialog eine textdatei, müsstest du dir nur anpassen

larryson · 30. Juli 2007

So, wie versprochen:

Insgesamt habe ich das ganze in drei einzelnen Modulen untergebracht.

Der Ablauf ist folgender: Einlesen der Datei, Prüfen auf korrekte Zeilenümbrüche, Speichern unter neuen Namen, Import der neu benamsten Datei in zwei Tabellen. In der neusten Version werden die alten Dateien gelöscht und die neu benamsten in ein Zip-File gespeichert.

Sollte Dir das nicht helfen, was bekommst Du für eine Fehlermeldung?

Code:

Sub umwandeln()

Dim sUnix As String
Dim sWin As String
Dim pfad As String
Dim datumstr As String

datumstr = Format(Date, "DD_MM_YYYY") + "__" + Format(Time, "hh_mm")

pfad = DateiOeffnen("H:\AV\", "Datei öffnen")

sUnix = ReadFile(pfad)
sWin = Unix2Windows(sUnix)
WriteFile "H:\AV\" & datumstr & "test.txt", sWin

einlesen ("H:\AV\" & datumstr & "test.txt")
End Sub

Function Unix2Windows(ByRef s As String) As String
  'Ist Zeilenumbruch vorhanden?
  If CBool(InStr(s, vbNewLine)) Then 'Ja:
    Unix2Windows = s
  Else 'Nein:
    Unix2Windows = Replace(s, vbLf, vbNewLine)
  End If
End Function
Function ReadFile(ByRef Path As String) As String
  Dim FileNr As Long
  
  'Falls nicht vorhanden, nichts zurückgeben:
  On Error Resume Next
  If FileLen(Path) = 0 Then Exit Function
  On Error GoTo 0
  
  'Datei einlesen:
  FileNr = FreeFile
  Open Path For Binary As #FileNr
    ReadFile = Space$(LOF(FileNr))
    Get #FileNr, , ReadFile
  Close #FileNr
End Function

Sub WriteFile(ByRef Path As String, ByRef Text As String)
  Dim FileNr As Long
  
  'Wenn Datei unverändert, dann abbrechen (ggf. weglassen):
  'If FileExists(Path) Then _
  '    If FileLen(Path) = Len(Text) Then _
          'If ReadFile(Path) = Text Then Exit Sub
  
  'Text speichern:
  FileNr = FreeFile
  Open Path For Output As #FileNr
  Print #FileNr, Text;
  Close #FileNr
End Sub

Public Function FileExists(Path As String) As Boolean
  Const NotFile = vbDirectory Or vbVolume

  On Error Resume Next
    FileExists = (GetAttr(Path) And NotFile) = 0
  On Error GoTo 0
End Function

Code:

Sub einlesen(datei)

Dim db As Database
Dim rs_head As DAO.Recordset
Dim rs_line As DAO.Recordset
Dim C As Long, i As Long, j As Long
Dim Tmp As String
Dim v As Variant
Dim Header As String
Dim pfad As String

Set db = CurrentDb
Set rs_head = db.OpenRecordset("tab_head")  'Anpassen
Set rs_line = db.OpenRecordset("tab_line")
C = FreeFile

'pfad = DateiOeffnen("H:\AV\", "Datei öffnen")
Open datei For Input As #C     'Anpassen

Do While Not EOF(C)
  Line Input #1, Tmp ' erste Zeile einlesen
  v = Tmp
  Header = Mid(v, 1, 4)       'die ersten 4 Zeichen werden ausgelesen die Daten an
                                            'die entsprechende Tabelle angefügt
  Select Case Header
  
    Case "HEAD"         'Die "HEAD" Zeile wird ausgelesen und an tab_head angefügt
        With rs_head
            .AddNew
            'bitte anpassen
            
            .Update
        End With
        
    Case "LINE"         'Die "LINE" Zeilen werden ausgelesen und an tab_LINE angefügt
        With rs_line
            .AddNew
             'bitte anpassen                 
            .Update
            End With
    End Select
Loop

'Aufräumen:
Close #C
rs_head.Close
rs_line.Close
Set rs_head = Nothing
Set rs_line = Nothing
Set db = Nothing

End Sub

Code:

'Datei öffnen Dialog
Option Compare Database
Option Explicit
 
Type DateiDialogStruktur
        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 String
End Type
 
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(DateiDialogStruktur As DateiDialogStruktur) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(DateiDialogStruktur As DateiDialogStruktur) As Long
 
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10
 
Dim DateiDialogStruktur As DateiDialogStruktur
 
Function DateiOeffnen(Verzeichnis As String, Fenstertitel As String) As String
On Error GoTo Err_DateiOeffnen
 
    Dim Dateityp As String
    Dim Dateiname_mit_Pfad As String
    Dim Dateiname As String
    Dim Rueckwerte As Long
 
    Dateityp = ""
 
' Dateitypen in der Auswahlliste des Dateityp's
'   Alle Dateien
    Dateityp = Dateityp & "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
' Access-Dateitypen
    Dateityp = Dateityp & _
    "Microsoft Access-Datenbanken (*.mdb)" & Chr$(0) & "*.mdb" & Chr$(0)
 
    Dateityp = Dateityp & _
    "Add-Ins (*.mda)" & Chr$(0) & "*.mda" & Chr$(0)
 
    Dateityp = Dateityp & _
    "Arbeitsgruppen-Dateien (*.mdw)" & Chr$(0) & "*.mdw" & Chr$(0)
 
    Dateityp = Dateityp & _
    "MDE-Dateien (*.mde)" & Chr$(0) & "*.mde" & Chr$(0)
 
' Word-Dateitypen
'   Word-Dokumente (*.doc)
'   Dokumentenvorlagen (*.dot)
'   Rich Text Format (*.rtf)
'   Textdateien (*.txt)
'   Schedule+-Kontakte (*.scd)
'   Persönliches Adreßbuch (*.pab)
'   Outlook-Adreßbuch (*.olk)
'   MS-DOS Text mit Layout (*.asc)
'   Text mit Layout (*.ans)
'   HTML Document (*.htm;*.html;*.htx)
'   Windows Write (*.wri)
'   Lotus 1-2-3 (*.wk1;*.wk3;*.wk4)
'   WordPerfect 6.x (*.wpd;*.doc)
'   Microsoft Excel-Arbeitsmappen (*.xls)
'   Works 3.0 für Windows (*.wps)
'   Works 4.0 für Windows (*.wps)
 
' Excel-Dateitypen
'   Textdateien (*.prn;*.txt;*.csv)
'   QuattroPro/DOS-Dateien (*.wq1)
'   Microsoft Works 2.0-Dateien (*.wks)
'   dBASE-Dateien (*.dbf)
'   Add-Ins (*.xla;*.xll)
'   Mustervorlagen (*.xlt)
'   Arbeitsbereiche (*.xlw)
'   Tabellen (*.xls)
 
'   Sicherungsdateien (*.xlk;*.bak)
'   HTML-Dateien (*.html;*.htm)
 
 
' Vorgegebenes Verzeichnis
    If Verzeichnis = "" Then
        ' Wenn leer, dann soll das aktuelle Verzeichnis verwendet werden
        Verzeichnis = CurDir$ & Chr$(0)
    Else
        ' ANSI "0" an das übergebene Verzeichnis anhängen
        Verzeichnis = Verzeichnis & Chr$(0)
    End If
 
    If Fenstertitel = "" Then
        ' Wenn kein Titel übergeben worden ist
        Fenstertitel = "Datei öffnen"
    Else
        ' ANSI "0" an übergebenen Fenstertitel anhängen
        Fenstertitel = Fenstertitel & Chr$(0)
    End If
 
' Speicherplatz für Dateieintrag (mit Pfadangabe) reservieren
    Dateiname_mit_Pfad = Space$(255) & Chr$(0)
 
' Speicherplatz für Dateieintrag (ohne Pfadangabe) reservieren
    Dateiname = Space$(255) & Chr$(0)
 
'Datenstruktur von DateiDialogStruktur festlegen
    DateiDialogStruktur.lStructSize = Len(DateiDialogStruktur)
    DateiDialogStruktur.hwndOwner = 0&
    'DateiDialogStruktur.hwndOwner = Application.hWndAccessApp
    DateiDialogStruktur.lpstrFilter = Dateityp
    DateiDialogStruktur.nFilterIndex = 1
    DateiDialogStruktur.lpstrFile = Dateiname_mit_Pfad
    DateiDialogStruktur.nMaxFile = Len(Dateiname_mit_Pfad)
    DateiDialogStruktur.lpstrFileTitle = Dateiname
    DateiDialogStruktur.nMaxFileTitle = Len(Dateiname)
    DateiDialogStruktur.lpstrInitialDir = Verzeichnis
    DateiDialogStruktur.lpstrTitle = Fenstertitel
    DateiDialogStruktur.flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST _
    Or OFN_HIDEREADONLY Or OFN_LONGNAMES
    DateiDialogStruktur.nFileOffset = 0
    DateiDialogStruktur.nFileExtension = 0
    DateiDialogStruktur.lCustData = 0
    DateiDialogStruktur.lpfnHook = 0
    DateiDialogStruktur.lpTemplateName = ""
 
    Rueckwerte = GetOpenFileName(DateiDialogStruktur)
 
    If Rueckwerte <> 0 Then
        DateiOeffnen = Left(DateiDialogStruktur.lpstrFile, _
        InStr(DateiDialogStruktur.lpstrFile, Chr$(0)) - 1)
    End If
 
Exit_DateiOeffnen:
    Exit Function
 
Err_DateiOeffnen:
    MsgBox Err.Description
    Resume Exit_DateiOeffnen
 
End Function

b00GI · 22. August 2007

Guten Tag,

und danke für die Hilfe erstmal.

Leider war ich seit 3 wochen im Urlaub, und konnte deswegen nicht antworten,
bzw. mir das Ergebnis anschauen.

Welche Fehlermeldung ich bekommen habe kann ich dir im moment nicht sagen,
da ich mich erst wieder in die Datenbank einarbeiten muss.

Ich werde dir bescheid geben, wenn ich genaueres weis.

Das war das erste mal, das jemand mir in diesem Forum geantwortet hat :suspekt:

Vielen dank für die Mühe.

b00GI · 24. August 2007

Guten morgen,

Ich habe nochmals nachgeprüft welche fehlermeldung ich bekomme,
es ist ein Laufzeitfehler, selbst wenn ich beim code im on-error teil eine msgbox eingebe, welche mir die Fehlernummer und beschreibung dazu ausgibt.

Ich hänge die Fehlermeldung die ich bekomme mit an, glaube aber nicht, das dies viel nützen wird.

Ich denke das es vom Filedialog kommt, evtl weil bei der Runtime Version die Rechte für den Dateizugriff beschränkt sind?

Vielen dank für die Hilfe.

larryson · 24. August 2007

Wow, die hatte ich auch noch nicht.

Kannst Du deinen Code mal im Einzelschritt-Modus abarbeiten, um zu sehen, in welcher Zeile er rausfliegt?

b00GI · 24. August 2007

Leider kann ich den Debugger nicht benutzen,
da ich das Problem nur in der Runtime Version von Access habe.

In der Access 2003 Version, in welcher ich auch Programmiere,
tritt der Fehler nicht auf...

In welcher Zeile er raus fliegt kann ich leider nicht beantworten.

larryson · 24. August 2007

Schade und sorry, aber mit der Runtime hab ich noch nicht gearbeitet. Ich muss mich hier wohl leider ausklinken.

b00GI · 27. August 2007

Kein problem, und danke für deine Hilfe.

Access Runtime und Filedialog

b00GI

Grünschnabel

larryson

Erfahrenes Mitglied

larryson

Erfahrenes Mitglied

b00GI

Grünschnabel

b00GI

Grünschnabel

Anhänge

larryson

Erfahrenes Mitglied

b00GI

Grünschnabel

larryson

Erfahrenes Mitglied

b00GI

Grünschnabel

Neue Beiträge