Office: (Office 2003) Access Suchen und Ersetzen Datenbank tabellengestützt!

Kamelkaze · 31. Januar 2009

Und wie binde ich das in eine Abfrage ein?

Code:

Option Compare Database
Option Explicit
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef pArray() As Any) As Long

Public Function TabelleSaeubern(sTab As String)

Dim rs As DAO.Recordset
Dim strSQL As String
Dim i As Integer

Set rs = CurrentDb.OpenRecordset(sTab, dbOpenSnapshot)

For i = 0 To rs.Fields.Count - 1
strSQL = strSQL & ",[" & sTab & "].[" & rs.Fields(i).Name & "]= ReplaceHtmlCodes([" & rs.Fields(i).Name & "])"
Next i

strSQL = Mid(strSQL, 2)
strSQL = "UPDATE [" & sTab & "] SET " & strSQL

'Debug.Print strSQL
CurrentDb.Execute strSQL

End Function

Public Function ReplaceHtmlCodes(ByVal sWert As String)

Static codeArray() As Variant
Dim i As Long
Dim strTemp As String

'1. Array einlesen (static verhindert, dass es bei jedem Funktionsaufruf gelesen wird
If SafeArrayGetDim(codeArray) = 0 Then
Dim rs As ADODB.Recordset
Dim SqlString As String
SqlString = "Select SuchenNach, ErsetzenDurch FROM tblSuchenErsetzen"
Set rs = New ADODB.Recordset
rs.Open SqlString, CurrentProject.Connection, adOpenStatic
codeArray() = rs.GetRows
rs.Close
Set rs = Nothing
End If

'2. Werte ersetzen
strTemp = sWert
For i = 0 To UBound(codeArray(), 2)
strTemp = Replace(strTemp, codeArray(0, i), codeArray(1, i), , , vbBinaryCompare)
Next

ReplaceHtmlCodes = strTemp

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

So steht der Code, wenn ich dann auf kompilieren und dann im Debugfenster starte, dann kommt der Fehler Agrumenttyp ByRef unverträglich

Arne Dieckmann · 31. Januar 2009

Du bindest das gar nicht eine Abfrage ein, sondern rufst einfach die Funktion TabelleSaeubern im Debug-Fenster auf, indem du dort den vorhin hinterfragten Ausdruck eingibst (natürlich mit dem richtigen Tabellennamen) und danach Enter drückst.

Was da mit den Datentypen nicht geht, weiß ich nicht. Evtl. musst du den einen Funktionskopf so ändern:
Code:

Public Function ReplaceHtmlCodes(sWert As String)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Du brauchst auf jden Fall noch einen Verweis auf die DAO-Bibliothek. S. dazu FAQ 7.11 (Klick mich)

Josef P. · 31. Januar 2009

Was da mit den Datentypen nicht geht, weiß ich nicht.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich Tippe auf Übergabe von NULL
Abhilfe:
Code:

Public Function ReplaceHtmlCodes(sWert As Variant) as variant
..
if isnull(sWert) then
ReplaceHtmlCodes = NULL
exit function
end if
...
end function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Außerdem sollte imo unbedingt die von Arne bereits vorgeschlagene Datentyp-Prüfung eingebaut werden. Sonst kann das bei Zahlen-Feldern lästig werden. *wink.gif*

Arne Dieckmann · 31. Januar 2009

Zum "Außerdem": Genau - aber ein bisschen Eigenleistung möchte ich hier auch sehen.

webhugo · 7. Januar 2021

von Arne Dieckmann

@Webhugo (falls du überhaupt noch mitliest): Bitte in Zukunft nicht mehr komplette Zitate verwenden - das ist meist überflüssig. Danke.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Danke für den Hinweis!

Kamelkaze · 31. Januar 2009

Code:

Option Compare Database
Option Explicit
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef pArray() As Any) As Long

Public Function TabelleSaeubern(sTab As String)

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim i As Integer

Set rs = CurrentDb.OpenRecordset(sTab, dbOpenSnapshot)

For i = 0 To rs.Fields.Count - 1
strSQL = strSQL & ",[" & sTab & "].[" & rs.Fields(i).Name & "]= ReplaceHtmlCodes([" & rs.Fields(i).Name & "])"
Next i

strSQL = Mid(strSQL, 2)
strSQL = "UPDATE [" & sTab & "] SET " & strSQL

'Debug.Print strSQL
CurrentDb.Execute strSQL

End Function

Public Function ReplaceHtmlCodes(sWert As Variant) As Variant

Static codeArray() As Variant
Dim i As Long
Dim strTemp As String

'1. Array einlesen (static verhindert, dass es bei jedem Funktionsaufruf gelesen wird
If SafeArrayGetDim(codeArray) = 0 Then
Dim rs As ADODB.Recordset
Dim SqlString As String
SqlString = "Select SuchenNach, ErsetzenDurch FROM tblSuchenErsetzen"
Set rs = New ADODB.Recordset
rs.Open SqlString, CurrentProject.Connection, adOpenStatic
codeArray() = rs.GetRows
rs.Close
Set rs = Nothing
End If

'2. Werte ersetzen
strTemp = sWert

If IsNull(sWert) Then
ReplaceHtmlCodes = Null
Exit Function
End If

For i = 0 To UBound(codeArray(), 2)
strTemp = Replace(strTemp, codeArray(0, i), codeArray(1, i), , , vbBinaryCompare)
Next

ReplaceHtmlCodes = strTemp

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Es bleibt der selbe Fehler vorausgesetzt ich hab das so gemacht, wie Ihr es gemeint habt.

"Fehler Agrumenttyp ByRef unverträglich" bedeutet doch, das irgendein Wert falsch übergeben wird oder?

Wozu dient dieser Befehl?
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef pArray() As Any) As Long

Gruß
Benjamin

Arne Dieckmann · 31. Januar 2009

Kommentiere die Zeile aus und kompiliere den Code: Dann wird die Zeile:
Code:

If SafeArrayGetDim(codeArray) = 0 Then
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

bemängelt.

Ich kann den Fehler nicht provozieren. Könntest du eine abgespeckte Beispieldatenbank hochladen, mit der man das Problem nachvollziehen kann?

Kamelkaze · 31. Januar 2009

Ah, okay

Arne Dieckmann · 31. Januar 2009

Ich kann den Fehler nur nachvollziehen, wenn ich die Funktion so aufrufe:
?TabelleSaeubern(Test)

mit
?TabelleSaeubern("Test")

Achte auf die Anführungszeichen!

geht's. Allerding solltest du die Abfrage auf Null noch ändern:
Code:

Option Compare Database
Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef pArray() As Any) As Long

Public Function TabelleSaeubern(sTab As String)

Dim Db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim i As Integer

Set rs = CurrentDb.OpenRecordset(sTab, dbOpenSnapshot)

For i = 0 To rs.Fields.Count - 1
strSQL = strSQL & ",[" & sTab & "].[" & rs.Fields(i).Name & "]= ReplaceHtmlCodes([" & rs.Fields(i).Name & "])"
Next i

strSQL = Mid(strSQL, 2)
strSQL = "UPDATE [" & sTab & "] SET " & strSQL

'Debug.Print strSQL
CurrentDb.Execute strSQL

End Function

Public Function ReplaceHtmlCodes(sWert As Variant) As Variant

Static codeArray() As Variant
Dim i As Long
Dim strTemp As String

'1. Array einlesen (static verhindert, dass es bei jedem Funktionsaufruf gelesen wird
If SafeArrayGetDim(codeArray) = 0 Then
Dim rs As ADODB.Recordset
Dim SqlString As String
SqlString = "Select SuchenNach, ErsetzenDurch FROM tblSuchenErsetzen"
Set rs = New ADODB.Recordset
rs.Open SqlString, CurrentProject.Connection, adOpenStatic
codeArray() = rs.GetRows
rs.Close
Set rs = Nothing
End If

If Not IsNull(sWert) Then
strTemp = sWert
For i = 0 To UBound(codeArray(), 2)
strTemp = Replace(strTemp, codeArray(0, i), codeArray(1, i), , , vbBinaryCompare)
Next
End If

ReplaceHtmlCodes = strTemp

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Kamelkaze · 31. Januar 2009

Danke! *dance

Ist das jetzt nur an den Anführungszeichen gescheitert? *stupid

Gruß Benjamin

kenny000 · 28. Februar 2012

Hab gerade versucht den Code in meine Datenbank einzubauen. Leider bekomme ich immer einen Laufzeitfehler beim ausführen des makros *frown.gif*

Also:
Habe ein Makro erstellt:
AusführenCode - Funktionsname: TabelleSaeubern("mac_dbf_clear")
-> mac_dbf_clear ist eine Abfrage!

Dann zum Code: wurde grundsätzlich von hier übernommen, jedoch mit einigen anpassungen...

Code:

Option Compare Database
Option Explicit

Private Declare PtrSafe Function SafeArrayGetDim Lib "oleaut32.dll" ( _
ByRef pArray() As Any) As Long
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

da ich ein 64bit system hab, musste ich hier PtrSafe einfügen.

Code:

Public Function TabelleSaeubern(sTab As String)

Dim Db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim i As Integer

Set rs = CurrentDb.OpenRecordset(sTab, dbOpenSnapshot)

For i = 0 To rs.Fields.Count - 1
strSQL = strSQL & ",[" & sTab & "].[" & rs.Fields(i).Name & "]= ReplaceHtmlCodes([" & rs.Fields(i).Name & "])"
Next i

strSQL = Mid(strSQL, 2)
strSQL = "UPDATE [" & sTab & "] SET " & strSQL

'Debug.Print strSQL
CurrentDb.Execute strSQL

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Hier fehlte mir noch das Objekt "Microsoft DAO 3.6". Habe ich dann auch in den Verweisen aktiviert. Soweit so gut...

Code:

Public Function ReplaceHtmlCodes(sWert As Variant) As Variant

Static codeArray() As Variant
Dim i As Long
Dim strTemp As String

'1. Array einlesen (static verhindert, dass es bei jedem Funktionsaufruf gelesen wird
If SafeArrayGetDim(codeArray) = 0 Then
Dim rs As ADODB.Recordset
Dim SqlString As String
SqlString = "Select ALT, NEU FROM Ersetzen"
Set rs = New ADODB.Recordset
rs.Open SqlString, CurrentProject.Connection, adOpenStatic
codeArray() = rs.GetRows
rs.Close
Set rs = Nothing
End If

If Not IsNull(sWert) Then
strTemp = sWert
For i = 0 To UBound(codeArray(), 2)
strTemp = Replace(strTemp, codeArray(0, i), codeArray(1, i), , , vbBinaryCompare)
Next
End If

ReplaceHtmlCodes = strTemp

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und hier natürlich den SqlString angepasst. Ich habe schon einige Foren durchstöbert und finde einfach keine Lösung.

Als Hintergrund, die Datenbank (mac_dbf) hat ca. 55000 Datensätze. Diese wird dann durch eine Abfrage auf ca. 32000 gekürzt. Und in dieser Abfrage (mac_dbf_clear) sollen dann eben noch die Wörter aus Tabelle "Ersetzen" in den Spalten "Gruppe1", "Gruppe2" und "Gruppe3" ersetzt werden.

Wollte das ganze zuerst mal nur in Gruppe1 anwenden.

Naja, vielleicht kann mir jemand weiterhelfen *Smilie

Office: (Office 2003) Access Suchen und Ersetzen Datenbank tabellengestützt!

Access Suchen und Ersetzen Datenbank tabellengestützt!

Access Suchen und Ersetzen Datenbank tabellengestützt!

Access Suchen und Ersetzen Datenbank tabellengestützt!

Access Suchen und Ersetzen Datenbank tabellengestützt!

Access Suchen und Ersetzen Datenbank tabellengestützt! - Similar Threads - Access Ersetzen Datenbank

Ausdruck eines Etiketts auf verschiedenen PCs steuern

Access als Mediaplayer

Smarttags in Access LTE (2021)

Excel zu Access

Access Neuer Datensatz im Formular

automatische Abfrage URL via Artikelnummer

Access 2000 Werte ersetzen