Access導(dǎo)齣csv文本文件時(shí)自動(dòng)爲(wèi)所有數(shù)據(jù)內(nèi)容加上引號(hào)併轉(zhuǎn)爲(wèi)UTF-8格式

最近有箇客戶需要將他Excel 或Access裡的所有聯(lián)繫人的資料 一鍵導(dǎo)入到他的華爲(wèi)手機(jī)裡。

剛開(kāi)始以爲(wèi)很簡(jiǎn)單，將華爲(wèi)手機(jī)的通信録導(dǎo)齣爲(wèi)csv格式，然後用Excel打開(kāi)這箇csv文本文件，再將Excel裡的其牠聯(lián)繫人資料複製到這箇文件裡麵（按衕樣的格式）

但結(jié)果髮現(xiàn)華爲(wèi)手機(jī)無(wú)法再讀入這些修改過(guò)的csv格式，經(jīng)過(guò)多次文件對(duì)比髮現(xiàn)

華爲(wèi)手機(jī)導(dǎo)齣的csv文件格式有些特彆，牠的數(shù)據(jù)內(nèi)容每箇字段欄位都用雙引號(hào)包括起來(lái)，

格式如下：

Family Name,Given Name,Additional Name,Prefix Name,Suffix Name,Mobile Number,Home Number,Office Number,Home Fax,Bussiness Fax,Pager,Other,customize,Home Email,Work Email,Other Email,customize,Address Home,Address Work,Address Other,customize,Organization Work,Organization Other,customize,AIM,Windows Live,YAHOO,SKYPE-USERNAME,OICQ,GOOGLE-TALK,JABBER,Notes,NickName,WebPage,Ptt/DC1,Ptt/DC2
"張三","","","","","1390000000","","","","","","","","","","","test@qq.com","","","","","廣東XXX事業(yè)部","行政助理","","","","","","","","","","","","",""
"李四",,,,,"1390000000",,,,,,,,,,,"xxxx@qq.com",,,,,"中山XXX科技",,,,,,,,,,,,,,

但Excel另存的csv格式把這些引號(hào)全去掉瞭，變成這樣瞭

Family Name,Given Name,Additional Name,Prefix Name,Suffix Name,Mobile Number,Home Number,Office Number,Home Fax,Bussiness Fax,Pager,Other,customize,Home Email,Work Email,Other Email,customize,Address Home,Address Work,Address Other,customize,Organization Work,Organization Other,customize,AIM,Windows Live,YAHOO,SKYPE-USERNAME,OICQ,GOOGLE-TALK,JABBER,Notes,NickName,WebPage,Ptt/DC1,Ptt/DC2
張三,,,,,1390000000,,,,,,,,,,,test@qq.com,,,,,廣東XXX事業(yè)部,行政助理,,,,,,,,,,,,,

後來(lái)隻有寫(xiě)一箇程序?qū)ｉT(mén)來(lái)添加這些導(dǎo)齣文件的雙引號(hào)

'讀寫(xiě)華爲(wèi)手機(jī)導(dǎo)齣的通信録CSV格式
'將數(shù)據(jù)庫(kù)中的聯(lián)繫人資料自動(dòng)寫(xiě)入華爲(wèi)手機(jī)通信録CSV格式，併自動(dòng)轉(zhuǎn)換爲(wèi)UTF-8格式
'Excel導(dǎo)齣的逗號(hào)隔開(kāi)的CSV格式或?qū)i的Unicode的文本文件格式 數(shù)據(jù)內(nèi)容都不會(huì)自動(dòng)加引號(hào)，華爲(wèi)手機(jī)無(wú)法正常導(dǎo)入
Private Sub cmdExport_Click()
 Dim fnum As Long
 Dim strPath As String
 Dim rs As DAO.Recordset
 Dim fld As DAO.Field
 Dim strRecord As String
 Dim strAll As String
 strPath = CurrentProject.Path
 
 If Dir(strPath & "\Export.csv") <> "" Then
    VBA.Kill strPath & "\Export.csv"
 End If
 
 If Dir(strPath & "\TPL.csv") <> "" Then
    VBA.FileCopy strPath & "\TPL.csv", strPath & "\Export.csv"
 End If
 fnum = FreeFile
 Open strPath & "\Export.csv" For Output As #fnum 'Append
 
 strAll = strAll & "Family Name,Given Name,Additional Name,Prefix Name,Suffix Name,Mobile Number,Home Number,Office Number,Home Fax,Bussiness Fax,Pager,Other,customize,Home Email,Work Email,Other Email,customize,Address Home,Address Work,Address Other,customize,Organization Work,Organization Other,customize,AIM,Windows Live,YAHOO,SKYPE-USERNAME,OICQ,GOOGLE-TALK,JABBER,Notes,NickName,WebPage,Ptt/DC1,Ptt/DC2" & vbCrLf
 Print #fnum, "Family Name,Given Name,Additional Name,Prefix Name,Suffix Name,Mobile Number,Home Number,Office Number,Home Fax,Bussiness Fax,Pager,Other,customize,Home Email,Work Email,Other Email,customize,Address Home,Address Work,Address Other,customize,Organization Work,Organization Other,customize,AIM,Windows Live,YAHOO,SKYPE-USERNAME,OICQ,GOOGLE-TALK,JABBER,Notes,NickName,WebPage,Ptt/DC1,Ptt/DC2"
 
 Set rs = CurrentDb.OpenRecordset("tblContact")
 Do While Not rs.EOF
    strRecord = ""
    For Each fld In rs.Fields
        strRecord = strRecord & "," & """" & rs(fld.Name) & """"
    Next
    If Len(strRecord) > 0 Then strRecord = Mid(strRecord, 2)
   ' Write #fnum, strRecord    ' 將數(shù)據(jù)寫(xiě)入文件。 '併會(huì)自動(dòng)加引號(hào)
    
    Print #fnum, strRecord
     strAll = strAll & strRecord & vbCrLf
    rs.MoveNext
 Loop
 rs.Close
 Close #fnum
 
' AnsiToUTF8 strPath & "\Export.csv", strPath & "\ExportUTF8.csv"
 
 Dim objStream As New ADODB.Stream
Dim str As String

'轉(zhuǎn)換爲(wèi)UTF-8 With objStream
    .Type = 2
    .Mode = 3
    .Open
   ' .LoadFromFile strPath & "\Export.csv"
    .Charset = "UTF-8"
    '將Ansi格式轉(zhuǎn)換爲(wèi)UTF-8格式
    .WriteText strAll, adWriteLine
    .SaveToFile strPath & "\ExportUTF8.csv", adSaveCreateOverWrite
    .Close
End With
 MsgBox "導(dǎo)齣成功，文件存放在：" & strPath & "\ExportUTF8.csv"
End Sub