我们将XML文件导入Access数据库。此数据包括一个描述列,其中可以包含特殊字符,如äé等。我们使用此数据库将表导出到我们的Financial程序。该程序无法处理这些特殊字符。因此,我想制作一个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)与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
但这不会返回任何内容。
预期结果应该是返回空格,其中所选列中包含特殊字符。
如前所述,代码根本不返回任何有效的函数。请告知。
答案 0 :(得分:0)
如果未链接xml文件但确实将其导入,则可以完全控制导入的数据。您可以创建一个附加表,其中每个XML文件都有一个字段“ TableName”,每个列都有一个字段“ FieldName”,每个要验证的特殊字符都有一个字段“ CharIn”,而替换字符有一个字段“ CharOut” 。然后构建代码以遍历导入的数据,然后根据您的新附加表进行搜索和替换。替换是默认功能,但是您可以编写自己的东西,例如
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
答案 1 :(得分:0)
根据@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;
再次感谢您解决我的问题!