office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

Access導出csv文本文件時自動為所有數據內容加上引號并轉為UTF-8格式

2017-07-26 18:15:00
zstmtony
原創
2415

最近有個客戶需要將他Excel 或Access里的所有聯系人的資料 一鍵導入到他的華為手機里。

剛開始以為很簡單,將華為手機的通信錄導出為csv格式,然后用Excel打開這個csv文本文件,再將Excel里的其它聯系人資料復制到這個文件里面(按同樣的格式)

但結果發現華為手機無法再讀入這些修改過的csv格式,經過多次文件對比發現


華為手機導出的csv文件格式有些特別,它的數據內容每個字段欄位都用雙引號包括起來,

格式如下:


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","","","","","","","","","","","[email protected]","","","","","廣東XXX事業部","行政助理","","","","","","","","","","","","",""
"李四",,,,,"1390000000",,,,,,,,,,,"[email protected]",,,,,"中山XXX科技",,,,,,,,,,,,,,


但Excel另存的csv格式把這些引號全去掉了,變成這樣了

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,,,,,,,,,,,[email protected],,,,,廣東XXX事業部,行政助理,,,,,,,,,,,,,


后來只有寫一個程序專門來添加這些導出文件的雙引號



'讀寫華為手機導出的通信錄CSV格式
'將數據庫中的聯系人資料自動寫入華為手機通信錄CSV格式,并自動轉換為UTF-8格式
'Excel導出的逗號隔開的CSV格式或導出的Unicode的文本文件格式 數據內容都不會自動加引號,華為手機無法正常導入
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    ' 將數據寫入文件。 '并會自動加引號
    
    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

'轉換為UTF-8 With objStream
    .Type = 2
    .Mode = 3
    .Open
   ' .LoadFromFile strPath & "\Export.csv"
    .Charset = "UTF-8"
    '將Ansi格式轉換為UTF-8格式
    .WriteText strAll, adWriteLine
    .SaveToFile strPath & "\ExportUTF8.csv", adSaveCreateOverWrite
    .Close
End With
 MsgBox "導出成功,文件存放在:" & strPath & "\ExportUTF8.csv"
End Sub
分享
北京十一选五基本走势