Blog Schröder

Sammlung von Codeschnipseln zu Programmierproblemen.
Daten aus fremden Quellen unterliegen deren Rechten.
Siehe auch: Disclaimer auf www.computer-schroeder.de

Dienstag, 29. September 2009

Fehler 8155: Keine Spalte wurde für Spalte x von DRVD_TBL angegeben

System: Access 2003 (ADP mit SQL Server 2005)

Dies ist ein Hinweis auf eine fehlerhafte SQL-Anweisung.
Bei mir entstand der Fehler, als die SQL-Anweisung zusammengestückelt wurde:

DoCmd.RunSQL "INSERT INTO myTAB (Wert) VALUES (" & txtFeld & ")"

Alles geht gut, wenn in txtFeld eine ganze Zahl steht. Steht aber eine Kommazahl (z.B. 0,5) drin, dann erscheint in der VALUES-Liste das  Komma, was bedeutet: es werden zwei Werte statt einem übergeben.
Das Komma wird mit folgender Schreibweise korrekt in den SQL-Dezimalpunkt umgewandelt:

DoCmd.RunSQL "INSERT INTO myTAB (Wert) VALUES (" & str(txtFeld) & ")"

Labels: , , , , ,

Dienstag, 23. Juni 2009

In Datenherkunft von Formularen und Berichten Textteile austauschen

Bei Änderungen an der Datenbankstruktur sollen auch Tabellen- und Feldnamen geändert werden. In Modulen geht das einfach durch STRG + H (Ersetzen). Die in Access-Objekten eingebetteten SQL-Anweisungen werden so nicht erwischt. Hierzu folgende Funktion, die zweckmäßigerweise aus einem Makro (s. Abb.) aufgerufen werden kann.

Argumente:

  1. oldString: das alte Textstück (z.B. "Länderschlüssel")
  2. newString: das stattdessen einzusetzende (z.B. "Laenderschluessel")
  3. findInForms: Ersetze in RecordSource jedes Formulars und Berichts (nur FALSE, falls nicht gewünscht)
  4. findInControls: Ersetze in RowSource aller Listen- und Kombinationsfelder (nur FALSE, falls nicht gewünscht)



Public Function RenamePartInRSources(oldString As String, newString As String, _
Optional findInForms As Boolean = True, Optional findInControls As Boolean = True)
'ersetzt in der Datenherkunft von Form/Control ein Wort durch ein anderes
On Error GoTo Er
Debug.Print "Ersetze " & oldString & " durch " & newString
If oldString = "" Then Err.Raise 10001, , "Parameterfehler oldString"
If newString = "" Then Err.Raise 10002, , "Parameterfehler newString"
If Not (findInForms Or findInControls) Then Err.Raise 10003, , "Parameterfehler findIn*"

Dim AO As AccessObject
Dim F As Form
Dim R As Report

Dim o As String
Dim s As String
Dim i As Integer

For Each AO In Application.CurrentProject.AllForms
DoCmd.OpenForm AO.Name, acDesign, , , acFormEdit, acHidden
Set F = Forms(AO.Name)
If findInForms Then 'in Formular ersetzen
o = F.RecordSource
' Debug.Print F.Name & ": " & F.RecordSource
s = Replace(o, oldString, newString)
F.RecordSource = s
If s <> o Then Debug.Print F.Name & ": " & F.RecordSource
s = ""
End If

If findInControls Then 'in Steuerelement ersetzen
For i = 0 To F.Controls.Count - 1
On Error Resume Next
o = F(i).RowSource
' Debug.Print F.Name & "." & F(i).Name & ": " & F(i).RowSource
s = Replace(o, oldString, newString)
F(i).RowSource = s
If s <> o Then Debug.Print F.Name & "." & F(i).Name & ": " & F(i).RowSource
On Error GoTo Er
s = ""
Next i
End If
DoCmd.Close acForm, AO.Name, acSaveYes
Next AO

For Each AO In Application.CurrentProject.AllReports
DoCmd.OpenReport AO.Name, acDesign, , , acHidden
Set R = Reports(AO.Name)
If findInForms Then 'in Bericht ersetzen
o = R.RecordSource
s = Replace(o, oldString, newString)
R.RecordSource = s
If s <> o Then Debug.Print R.Name & ": " & R.RecordSource
s = ""
End If

If findInControls Then 'in Steuerelement ersetzen
For i = 0 To R.Controls.Count - 1
On Error Resume Next
o = R(i).RowSource
s = Replace(o, oldString, newString)
R(i).RowSource = s
If s <> o Then Debug.Print R.Name & "." & R(i).Name & ": " & R(i).RowSource
On Error GoTo Er
s = ""
Next i
End If
DoCmd.Close acReport, AO.Name, acSaveYes
Next AO
Ex:
Set AO = Nothing
Set F = Nothing
Set R = Nothing
Debug.Print "RenamePartInRSources beendet."
Exit Function
Er: MsgBox "Fehler " & Err.Number & " in Tools.RenamePartInRowSource" _
& vbCrLf & Err.Description
Resume Ex
End Function

Labels: , , , , , , , ,

Dienstag, 2. Juni 2009

Access-Formular: beim Datensatz bleiben

Donkarl.com 4.5 empfiehlt die Bookmark-Methode:
Me.Painting = False 'Bildschirmflackern reduzieren
... 'SQL o.a.
Dim v 'Variant
v = Me.Recordset.Bookmark
Me.Requery 'Requery zeigt normal den ersten Datensatz an
Me.Bookmark = v
Me.Painting = True

Die Suchmethode:
Me.Painting = False 'Bildschirmflackern reduzieren

... 'SQL o.a.
'nach Löschbefehl: auf nächste Zeile
'DoCmd.GoToRecord , , acNext
Dim pos As String
pos = txtDatenfeld
Me.Requery 'Das böse Requery
DoCmd.FindRecord pos, , , , , acAll
Me.Painting = True

Dann gibts auch noch Seek
und ev. DoCmd.GotoRecord Next

Labels: , , , ,

Sonntag, 10. Mai 2009

VBA in MS Office bringt "Unerwarteter Fehler"

Die Lösung
auf: http://www.herber.de/forum/archiv/716to720/t716089.htm
von: Christoph Dümmen
Geschrieben am: 07.01.2006 16:05:30

thanks to Tony Jollans in microsoft.public.word.vba.general

This sounds like corruption. If reinstalling Office doesn't help, try
deleting the VBA key in the registry (which is left unchanged by
(re)installation) ...

HKEY_CURRENT_USER\Software\Microsoft\VBA

If you delete this key, a clean copy should be created from built-in
defaults when you open the VBE.

Labels: , , , , , ,

Freitag, 3. April 2009

Feldinhalt aufteilen, z.B. Straße und Hausnummer

Public Function PosHsNrInStrasse(Strasse As String) As Integer
    Dim Zaehler     As Integer
    Dim Laenge      As Integer
    Dim X           As String
    Dim Ergebnis    As String
   
    Laenge = Len(Strasse)
    PosHsNrInStrasse = 0
'von rechts nach links durch Strassennamen gehen
'bis auf die 3 linken Zeichen damit Strassen, die mit Zahl beginnen
'(z.B. 3. Terwestenweg) nicht als Hausnummer erkannt werden
    For Zaehler = Laenge To 3 Step -1
        X = Mid(Strasse, Zaehler, 1)         'aktuell zu prüfendes Zeichen
        If IsNumeric(X) Then                 'prüfen, ob Zeichen eine Zahl ist
            PosHsNrInStrasse = InStr(Strasse, X)            'Position der Zahl
        End If
    Next
End Function

Public Function HsNr(Strasse As String) As String
    Dim pos     As Integer
    Dim Laenge  As Integer
   
    pos = PosHsNrInStrasse(Strasse)
    Laenge = Len(Strasse)
    If pos > 0 Then
        HsNr = Right(Strasse, Laenge - pos + 1)
      Else
        HsNr = ""
    End If
   
End Function

Public Function StrName(Strasse As String) As String
    Dim pos     As Integer
    Dim Laenge  As Integer
   
    pos = PosHsNrInStrasse(Strasse)
    Laenge = Len(Strasse)
    If pos > 0 Then
        StrName = Trim(Left(Strasse, pos - 1))
      Else
        StrName = Strasse
    End If
 End Function


Quelle: Ludger auf  www.Office-Loesung.de

Labels: , , , , ,

Mittwoch, 1. April 2009

Aus VBA Word-Dokument erzeugen und darin Textmarken überschreiben


filesys:       Filesystemobjekt (vorher angelegt)
wdApp:         Word.Application-Objekt (vorher angelegt)
TEMPLATENAME:  Dateiname (inkl. Pfad) einer .DOT-Datei
STRINGCONTROL: Textbox o.a., enthält Name der Textmarke

...
'
existiert die Dokumentvorlage? 
    Dim bEx As Boolean
    On Error GoTo Er
    If Not filesys.FileExists(TEMPLATENAME) Then
        MsgBox "Die Dokumentvorlage " &
TEMPLATENAME & " wurde nicht gefunden."
        GoTo Ex
    End If
    On Error Resume Next
'prüfen, ob das Word-Objekt (noch) existiert
    Err.Clear
    bEx = wdApp.Documents.Count = 0
    If Err.Number = 462 Or Err.Number = 91 Then
        Set wdApp = Nothing
        Set wdApp = New Word.Application
        Resume
    ElseIf Err.Number > 0 Then
        GoTo Er
    End If
'erstelle das neue Dokument   
    On Error GoTo Er
    wdApp.Documents.Add
TEMPLATENAME, False, wdNewBlankDocument, True

'ersetze Textmarke durch einen Text   
    With wdApp.Documents(wdApp.Documents.Count)  'das zuletzt angelegte Dokument
        On Error Resume Next
        .Visible = False
        'Beispiel: Eine Textmarke namens Firma wird überschrieben
        Dim bmString As String: bmString = STRINGCONTROL & ""
        bEx = .Bookmarks.Exists("Firma")
        If bmString & "" > "" And bEx Then
            wdApp.Selection.Goto what:=wdGoToBookmark, Name:="Firma"
            wdApp.Selection.TypeText Text:=bmString
        End If
...
    End With
'Zeige das Dokument an   
    wdApp.Selection.Goto wdGoToLine, wdGoToFirst
    wdApp.Visible = True
    wdApp.Activate
...
'Fehlerbehandlung
Ex: Exit Function
Er: MsgBox "Fehler " & Err.Number & " in NAMEOFPROCEDURE" _
    & vbCrLf & Err.Description
    Resume Ex
End...



nicht vergessen:

SET filesys=nothing
Set wdApp=Nothing


Labels: , , , , , ,

Die ausgewählten Items einer Listbox in String sichern

Public Sub SelectedFromStringToListBox(ByVal gesamtString As String, Liste As ListBox)
    On Error GoTo Er
    Dim v
    Dim i As Integer
    Dim j As Integer
    With Liste
        For Each v In .ItemsSelected
            .Selected(v) = False
        Next v
        v = Split(gesamtString, "; ")
        For i = 0 To UBound(v)
            For j = 0 To .ListCount - 1
                If v(i) = .ItemData(j) Then
                    .Selected(j) = True
                    Exit For
                End If
            Next j
        Next i
    End With
Ex: Exit Sub
Er: MsgBox "Fehler " & Err.Number & " in SelectedFromStringToListBox" _
    & vbCrLf & Err.Description
    Resume Ex
End Sub


Public Function SelectedFromListbox(ByVal Liste As ListBox) As String
    On Error GoTo Er
    Dim s As String
    Dim v
    s = ""
    For Each v In Liste.ItemsSelected
        If s > "" Then s = s & "; "
        s = s & Liste.ItemData(v)
    Next v
Ex:
    SelectedFromListbox = s
    Exit Function
Er: MsgBox "Fehler " & Err.Number & " in SelectedFromListbox" _
    & vbCrLf & Err.Description
    s = ""
    Resume Ex
End Function



Labels: , , ,

Montag, 19. Januar 2009

Unterformular zeigt leeres Rechteck

Das Problem taucht in Accessprojekten (2002/2003) auf Basis SQL Server 2005 auf.
Die Datenherkunft darf in der ORDER BY-Klausel keine Bezeichnungen wie "XY.ID" enthalten. Erlaubt sind in dieser Klausel nur reine unqualifizierte Feldnamen wie "ID".

Hilfen:
Bearbeite die ORDER BY-Klausel für diesen Zweck in der SQL-Box, nicht per Abfrageassistent (er fügt den Tabellennamen bzw. -alias wieder zu).

Weise allen nicht eindeutigen Feldnamen, die in ORDER BY vorkommen, einen Alias zu und schreibe diesen hinter ORDER BY.

Notfalls eine Tabelle tabelle1 durch eine Unterabfrage ersetzen a la
...
FROM (Select ID as XYID, ... From tabelle1) AS XY
...

Labels: , , ,

Dienstag, 16. Dezember 2008

DTPicker zur Datumeingabe

Value kann nur eingegeben werden, wenn CheckBox auf True steht.

Value = Empty für das aktuelle Datum (als Voreinstellungswert?).

DTPicker1.CheckBox=False läßt die doofe Checkbox schließlich verschwinden.
(Achtung, die CheckBox-Eigenschaft kommt nicht in der Auswahlliste vor!)

---------------------------------------------------------
Praktische Anwendung:

a) DTPicker1 an kein Feld der Tabelle binden!
b) in Form.Current:
'Fülle den Picker mit dem Anfangswert
DTPicker1 .CheckBox = True
DTPicker1 = FeldAusDatenbank (oder Date oder was auch immer)
'kein NULL übergeben!
DTPicker1 .CheckBox = False
c) in DTPicker1_Exit:
'hat sich Wert geändert?
If FeldAusDatenbank = DTPicker1 Then Exit Sub
'schreib den neuen Wert zurück
FeldAusDatenbank = DTPicker1(oder was auch immer)
'eventuell nötig: Datensatz speichern
DoCmd.RunCommand acCmdSaveRecord

Labels: , , ,

Montag, 29. September 2008

Drucken mit VBA

Dim view As Long, merk As String

Private Sub btnAnsicht_Click()
'Druckvorschau oder Ausdruck?
  If Me!btnAnsicht Then
    Me!btnAnsicht.Caption = "Ansicht"
    view = acPreview
  Else
    Me!btnAnsicht.Caption = "Drucken"
    view = acNormal
  End If
End Sub

Private Sub btnDruck_Click()
  DoCmd.OpenReport "rptTest", view
End Sub

Private Sub kmbDrucker_AfterUpdate()
'Ein Drucker wurde gewählt
Dim tmp As String
  tmp = Nz(Me!kmbDrucker, "")
  If tmp <> "" Then SetDefaultPrinter tmp
End Sub

Private Sub Form_Close()
'Standarddrucker setzen
  SetDefaultPrinter merk
End Sub

Private Sub Form_Load()
'alle Drucker in Kombifeld übernehmen
  btnAnsicht_Click
  Me!kmbDrucker.RowSource = GetWindowDeviceNames()
  merk = GetDefaultPrinterName()
  Me!kmbDrucker = merk
End Sub

Labels: , ,

Mittwoch, 13. August 2008

Verbindung eines ADP zur Laufzeit festlegen

Folgende VBA-Prozedur weist dem ADP eine neue Verbindung zu:

Public Sub OpenADPConnection(ByVal strUser As String, ByVal strPassword As String)
Const strCONNECTION_STRING As String ="Provider=SQLOLEDB;Data Source=deinServer;Initial Catalog=deineDatenbank"
CurrentProject.OpenConnection strCONNECTION_STRING, strUser, strPassword
If Not CurrentProject.IsConnected Then
MsgBox "Es konnte keine Verbindung hergestellt werden!"
End If
End Sub


Unangenehmer Effekt:
Access versucht, beim Start einer Anwendung die letzte Verbindung wiederaufzubauen und endet nach Wartezeit mit einem Fehler.
Verhinderung:
Man sollte seine ADP-Anwendung ohne Verbindungsdaten ausliefern und dann, wie oben beschrieben, die Verbindung per VBA beim Start der Anwendung aufbauen.
Die gespeicherten Verbindungsinformationen kann man aus der Anwendung entfernen, indem man per VBA die OpenConnection-Methode ohne Parameter aufruft.

Call CurrentProject.OpenConnection


Danach ist das ADP beim Start verbindungslos und es wird nicht mehr automatisch versucht, eine Verbindung aufzubauen.

Labels: , , , , ,

Mittwoch, 23. Januar 2008

MsgBox überschreiben

Public Function MsgBox(strText As String, _
Optional intSymbol As VbMsgBoxStyle= vbOKOnly, _
Optional strTitel As String = "Anwendung") As VbMsgBoxResult

If Left(strText, 6) = "Fehler" And IsMissing(strTitel) Then
MsgBox = VBA.MsgBox(strText, intSymbol, strTitel & " - Fehlermitteilung")
Else
MsgBox = VBA.MsgBox(strText, intSymbol, strTitel)
End If
End Function

Hinweise:
Den Standardwert des optionalen Arguments strTitel (hier "Anwendung") passend ersetzen.
Wenn der Text mit dem Wort "Fehler" beginnt, erscheint ein entsprechender Titelleistentext (Falls keiner übergeben wurde).
Beachte: Mit VBA.MsgBox(... wird auf die originale MsgBox-Funktion zugegriffen.

Labels: , , , ,