Как создать функцию VBA в Access, чтобы заменить любой специальный символ в таблице - PullRequest
1 голос
/ 03 июня 2019

Мы импортируем XML-файлы в базу данных Access. Эти данные включают в себя столбец описания, который может содержать специальные символы, такие как ä и т. Д. Мы используем эту базу данных для экспорта таблицы в нашу финансовую программу. Эта программа не может обрабатывать эти специальные символы. Поэтому я хотел бы сделать функцию VBA, которая может заменить любой специальный символ в конкретной таблице / столбце.

Я довольно новичок в использовании VBA, поэтому я много использовал Google, чтобы попытаться найти некоторую предысторию по этой теме. Я нашел этот код для Excel и думаю, что его можно использовать и в Access. Однако я не могу установить соединение с функцией обновления таблицы.

Function RemovePunctuation(Txt As String) As String
With CreateObject("VBScript.RegExp")
.Pattern = "[^A-Z0-9 ]"
.IgnoreCase = True
.Global = True
RemovePunctuation = .Replace(Txt, "")
End With
End Function

Функция выше (RemovePunctuation) работает с Query in Access и возвращает список со значениями исходной таблицы без пунктуации. Я использовал следующий запрос:

SELECT RemovePunctuation([ColumnName]) AS [Add]
FROM TableName;

Однако это возвращает новую таблицу вместо замены значений в исходной таблице. Можно ли поделиться информацией в другом запросе, который использует функцию для обновления исходной таблицы?

Потому что я действительно новичок в этом, я не могу много показать. Я ожидаю, что код будет выглядеть так:

Function UpdateTable(Table As String, Column As String) As String
Update Table Set Column = 
With CreateObject("VBScript.RegExp")
.Pattern = "[^A-Z0-9 ]"
.IgnoreCase = True
.Global = True
RemovePunctuation = .Replace(Txt, "")
End With
End Function

Но это ничего не возвращает.

Ожидаемый результат должен возвращать пробелы, где в выбранном столбце есть специальные символы

Как уже упоминалось, код ничего не возвращает, поскольку эта функция вообще не является допустимой. Пожалуйста, сообщите.

Ответы [ 2 ]

0 голосов
/ 08 июня 2019

На основании кода, предоставленного @jeroen jong, на вопрос дан ответ. Ниже приведен код для замены специальных символов в любой таблице в Access:

Один модуль выполнен со следующим кодом:

Option Compare Database
Option Explicit

Private Const strObject As String = "modConversion"

Function ReplaceString(strCaller As String, memText As Variant, strSearch As String, 
strReplace As String) As Variant
On Error GoTo Err_Function

'Define variables
Dim strProcedure    As String       'name of current procedure
Dim dblPos          As Double      'pointer in text

'Initialise variables
strProcedure = "ReplaceString"

'Walk through the text, search and replace
dblPos = InStr(memText, strSearch)
Do While dblPos > 0
   If Asc(strSearch) = Asc(Mid$(memText, dblPos, 1)) Then
      memText = Left$(memText, dblPos - 1) + strReplace + Mid$(memText, dblPos + Len(strSearch))
      dblPos = Abs(dblPos - Len(strSearch))
   End If
   dblPos = InStr(dblPos + 1, memText, strSearch)
Loop

ReplaceString = memText

Exit_Function:
Exit Function

Err_Function:
MsgBox Err.Number, Err.Description, Err.Source, strObject, strProcedure
ReplaceString = memText
Resume Exit_Function

End Function

Одна функция создается при вызове функции ReplaceString. В этом случае он вызывается из формы с кнопкой:

Option Compare Database
Option Explicit

Private Const strObject As String = "frmReplace"

Private Sub cmdReplace_Click()
On Error GoTo Err_Sub

'Define variables
Dim strProcedure    As String       'name of current procedure
Dim dbs             As DAO.Database
Dim rsTable         As DAO.Recordset
Dim rsReplace       As DAO.Recordset
Dim strFieldName    As String

'Initialise variables
strProcedure = "cmdReplace_Click"

'Initialise database and recordset
Set dbs = CurrentDb
Set rsReplace = dbs.OpenRecordset("tblReplace", dbReadOnly)

With rsReplace
Do While Not .EOF
   'Open table
   Set rsTable = dbs.OpenRecordset(!TableName, dbOpenDynaset)
   'Walk through all records, and replace char in field
   Do While Not rsTable.EOF
      rsTable.Edit
        rsTable(!FieldName) = ReplaceString(strProcedure, rsTable(!FieldName), !TextSearch, !TextReplace)
      rsTable.Update
      rsTable.MoveNext
   Loop     'rsTable

   .MoveNext
   rsTable.Close
Loop 'rsReplace

.Close
End With

MsgBox "Replacement of special characters is completed", vbInformation, "Replace"

Exit_Sub:
On Error Resume Next
rsTable.Close
Set rsTable = Nothing
rsReplace.Close
Set rsReplace = Nothing
dbs.Close
Set dbs = Nothing

Exit Sub

Err_Sub:
MsgBox Err.Number & " - " & vbLf & Err.Description & " - " & vbLf & Err.Source, vbCritical, strObject & "-" & strProcedure
Resume Exit_Sub

End Sub

Таблица для предоставления данных для поиска и замены состоит из следующих столбцов:

Id As Id;
TableName As String;
FieldName As String;
Replace As Boolean;
TextSearch As String;
TextReplace As String;
CaseSensitive As Boolean;

Еще раз спасибо за решение моего вопроса!

0 голосов
/ 03 июня 2019

В случае, если файл xml не связан, но действительно импортирован, у вас есть полный контроль над импортированными данными. Вы можете создать дополнительную таблицу, в которой у вас есть поле «TableName» для каждого файла XML, поле «FieldName» для каждого столбца, поле «CharIn» для каждого специального символа для проверки и поле «CharOut» для заменяющего символа , Затем создайте код, чтобы просмотреть импортированные данные, а затем выполнить поиск и замену на основе новой таблицы. Replace является функцией по умолчанию, но вы можете написать свою собственную, что-то вроде

Function ReplaceString(strCaller As String, memText As Variant, strSearch As String, strReplace As String) As Variant

'Define variables
Dim dblPos          As Double      'pointer in text

'Walk through the text, search and replace
dblPos = InStr(memText, strSearch)
Do While dblPos > 0
   If Asc(strSearch) = Asc(Mid$(memText, dblPos, 1)) Then
      memText = Left$(memText, dblPos - 1) + strReplace + Mid$(memText, dblPos + Len(strSearch))
      dblPos = Abs(dblPos - Len(strSearch))
   End If
   dblPos = InStr(dblPos + 1, memText, strSearch)
Loop

ReplaceString = memText
...