安徽彩票大奖 欧洲百万乐透大奖 七星彩17049规律大奖 双色球中大奖领奖过程 3d近期中大奖故事 广州番禺中福彩大奖的 鸡男注定会中大奖 2016江苏彩民中大奖 趣彩网大奖网黑平台 大乐透4.97亿大奖 霍邱一彩民6元中双色球547万大奖 双色球黑龙江中大奖图 体育彩票中大奖名单 什么样的人能中大奖 彩票大奖作假

Access导出csv文本文件时自动为所有数据内容加上引号并转为UTF-8格式

2017-07-26 18:15:00
zstmtony
原创
1434

最近有个客户需要将他Excel 或Access里的所有联系人的资料 一键导入到他的华为手机里。

刚开?#23478;?#20026;很简单,将华为手机的通信录导出为csv格式,然后用Excel打开这个csv文本文件,再将Excel里的其它联系人资料复制到这个文件里面(按同样的格式)

但结果发现华为手机无法再读入这些修改过的csv格式,经过多次文件对比发现


华为手机导出的csv文件格式有些特别,它的数据内容每个字段栏位?#21152;?#21452;引号包括起来,

格式如下:


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事业部,行政助理,,,,,,,,,,,,,


后来只有写一个程序专门来添加这些导出文件的双引号



'?#21015;?#21326;为手机导出的通信录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
分享
? 1999-2019 Office交流网?? 中山市天鸣科技发展有限公司 粤ICP备10043721号-5 SQL查询:19
内存?#21152;茫?b>7.75MB
PHP 执行时间:0.14
双色球大奖2000年
安徽彩票大奖 欧洲百万乐透大奖 七星彩17049规律大奖 双色球中大奖领奖过程 3d近期中大奖故事 广州番禺中福彩大奖的 鸡男注定会中大奖 2016江苏彩民中大奖 趣彩网大奖网黑平台 大乐透4.97亿大奖 霍邱一彩民6元中双色球547万大奖 双色球黑龙江中大奖图 体育彩票中大奖名单 什么样的人能中大奖 彩票大奖作假