导入Access并导出到Excel时字符更改

时间:2013-05-15 01:11:40

标签: excel vba ms-access

我正在使用Access数据库,我在其中导入从xls转换的csv文件 通常这是有效的,但是最近一个文件有一些字段,在导入到Access

之后字符在字段内发生变化

例如: 短划线变为û
一个开头的双引号变为ô
结尾双引号更改为ö

根据我的阅读,它与7或8位字符代码有关...这不是我真正理解的东西。

我的问题是,有什么方法可以阻止这种角色的改变,还是有比我已经尝试过的更好的东西? 或者是否有任何潜在的问题,我没有遇到过以下示例中似乎有用的内容?

这是我迄今为止尝试过的似乎有效的方法

从原始Excel文件另存为unicode文本文件(对我而言是新的)

    ActiveWorkbook.SaveAs Filename:= _ 
"D:\NewFiles\ReportList.txt", FileFormat:=xlUnicodeText _ 
    , CreateBackup:=False 

然后使用以下代码导入数据库

    DoCmd.TransferText acImportDelim, "ReportList  Import Specification", "tbl_ReportList", "D:\NewFiles\ReportList.txt", True 

这似乎正确地将文本导入数据库。

其他人使用数据,然后从Access导出到Excel的新报表。 这会将字体更改为MS Sans Serif并再次更改字符,但不会像导入时那样更改。 导出Excel报表后,我将字体更改为Arial,字符再次正确....至少到目前为止。

我过去没有遇到过这个角色变化,我的解决方案似乎有效,但我不确定是否还有其他潜在问题,或者我是否遗漏了什么。我还没有找到这个具体问题的答案。

感谢您花时间来帮助解决这个问题。

1 个答案:

答案 0 :(得分:0)

这是我过去用来规避字符编码问题的方法。

我怀疑这种方法也应该在Excel和Access之间起作用 - 尽管Access并不是我熟悉的东西。

此子指定文件的全名&路径,以及新文件名的目的地&路径。如果你想覆盖现有的,这些可能是相同的。

注意在一些简单的测试中,我无法从Excel中读取保存为“Unicode”的文件,但它可以完美地保存为“Tab Delimited TXT”文件和CSV /逗号分隔文件。

Sub OpenAndSaveTxtUTF8()
Dim txtFileName as String
Dim newTxtFileName as String

txtFileName = "D:\NewFiles\ReportList.txt"
newTxtFileName = "D:\NewFiles\UTF8_ReportList.txt"

WriteUTF8(ReadTextFile(txtFileName), newTxtFileName)

End Sub

这个子调用了我从代码注释中记入的来源借来的两个函数。 WriteUTF8ReadTextFile的内容创建一个正确的UTF8文件,该文件返回完整文件内容的字符串。

Function ReadTextFile(sFileName As String) As String
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=699
    Dim iFile As Integer

    On Local Error Resume Next
     ' \\ Use FreeFile to supply a file number that is not already in use
    iFile = FreeFile

     ' \\ ' Open file for input.
    Open sFileName For Input As #iFile

     ' \\ Return (Read) the whole content of the file to the function
    ReadTextFile = Input$(LOF(iFile), iFile)

    Close #iFile
    On Error GoTo 0
End Function

此函数需要对ADODB库的引用,或者您可以Dim objStream As Object,代码仍然适合您。

Function WriteUTF8(textString$, myFileOut$)
'Modified from http://www.vbaexpress.com/forum/showthread.php?t=42375
'David Zemens - February 12, 2013

'Requires a reference to ADODB?

     ' UTF8()  Version 1.00
     ' Open a "plain" text file and save it again in UTF-8 encoding
     ' (overwriting an existing file without asking for confirmation).
     '
     ' Based on a sample script from JTMar:
     ' http://bytes.com/groups/asp/52959-save-file-utf-8-format-asp-vbscript
     '
     ' Written by Rob van der Woude
     ' http://www.robvanderwoude.com

    Dim objStream As ADODB.Stream

     ' Valid Charset values for ADODB.Stream
    Const CdoBIG5 = "big5"
    Const CdoEUC_JP = "euc-jp"
    Const CdoEUC_KR = "euc-kr"
    Const CdoGB2312 = "gb2312"
    Const CdoISO_2022_JP = "iso-2022-jp"
    Const CdoISO_2022_KR = "iso-2022-kr"
    Const CdoISO_8859_1 = "iso-8859-1"
    Const CdoISO_8859_2 = "iso-8859-2"
    Const CdoISO_8859_3 = "iso-8859-3"
    Const CdoISO_8859_4 = "iso-8859-4"
    Const CdoISO_8859_5 = "iso-8859-5"
    Const CdoISO_8859_6 = "iso-8859-6"
    Const CdoISO_8859_7 = "iso-8859-7"
    Const CdoISO_8859_8 = "iso-8859-8"
    Const CdoISO_8859_9 = "iso-8859-9"
    Const cdoKOI8_R = "koi8-r"
    Const cdoShift_JIS = "shift-jis"
    Const CdoUS_ASCII = "us-ascii"
    Const CdoUTF_7 = "utf-7"
    Const CdoUTF_8 = "utf-8"

     ' ADODB.Stream file I/O constants
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adSaveCreateNotExist = 1
    Const adSaveCreateOverWrite = 2

    On Error Resume Next

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Open
    objStream.Type = adTypeText
    objStream.Position = 0
    objStream.Charset = CdoUTF_8


'We are passing a string to write to file, so omit the following line
'    objStream.LoadFromFile myFileIn

'And instead of using LoadFromFile we are writing directly from the COPIED
' text from the unsaved/temp instance of Notepad.exe
objStream.WriteText textString, 1

    objStream.SaveToFile myFileOut, adSaveCreateOverWrite
    objStream.Close
    Set objStream = Nothing

    If Err Then
        WriteUTF8 = False
    Else
        WriteUTF8 = True
    End If

    On Error GoTo 0
End Function