Access - Importar y exportar a archivos txt

' Esta función devuelve el texto sin acentos    

'  Eduardo@olaz.net 

Public Function TextoSinAcentos(ByVal Texto As String) As String

  Dim lngTexto As Long

Dim i As Long

Dim lngPos As Long

Dim strCaracter As String * 1

Dim strNormalizado As String

Dim strConAcentos As String

Dim strSinAcentos As String

lngTexto = Len(Texto)

If lngTexto = 0 Then

    TextoSinAcentos = ""

    Exit Function

End If

strConAcentos = "ÁÀÂÄÃáàâäãÉÈÊËéèêëÍÌÎÏíìîïÓÒÔÖÕóòôöõÚÙÛÜúùûüÝýÿ"

strSinAcentos = "AAAAAaaaaaEEEEeeeeIIIIiiiiOOOOOoooooUUUUuuuuYyy"

For i = 1 To lngTexto

       strCaracter = Mid(Texto, i, 1)        'comparamos el caracter con la cadena con acentos        

       lngPos = InStr(1, strConAcentos, strCaracter, vbBinaryCompare)       'si se ha encontrado coincidencia 

       If lngPos <> 0 Then            'sustituímos el caracter con el que tiene la misma            

                                                     'posición en la cadena sin acentos (o sea la letra sin acentos)            

            strCaracter = Mid(strSinAcentos, lngPos, 1)

       End If

     '... y si no, pues seguimos como si nada        

    TextoSinAcentos = TextoSinAcentos & strCaracter

Next i

End Function

Private Sub bt_acentos_Click()

'restringir-simbolos-acentos-y-caracteres-campo-texto

'Declaramos las variables

Const carConAc As String = "áéíóú¡¿"

Const carSinAc As String = "aeiou  "

Dim vTexto As String

Dim i As Integer, largoTexto As Integer

Dim mtzConAc(Len(carConAc))

Dim mtzSinAc(Len(carSinAc))

'Rellenamos la primera matriz con acentos

For i = 1 To Len(carConAc)

mtzConAc(i) = Mid(carConAc, i, 1)

Next

'Rellenamos la segunda matriz sin acentos

For i = 1 To Len(carConAc)

mtzSinAc(i) = Mid(carSinAc, i, 1)

Next

'Asignamos valor a las variables

vTexto = Nz(Me.TxtCampo.Value, "")

'Si no se ha escrito nada no se ejecuta nada

If vTexto = "" Then Exit Sub

'Cogemos la longitud del texto

largoTexto = Len(vTexto)

'Iniciamos el proceso de reemplazo

For i = 1 To Len(carConAc)

vTexto = Replace(vTexto, mtzConAc(i), mtzSinAc(i))

Next i

'Reescribimos el texto sin acentos

Me.TxtCampo.Value = vTexto

End Sub