代码从32位电话换到64位电脑上就无法运行了

Nsp=娜！再来#

创造手机联系人通讯录的代码，从32位电话换到64位电脑上就无法运行了，请老师们帮忙修改一下代码，谢谢！
创造手机联系人通讯录.zip (52.94 KB, 下载次数: 13)

2018-10-3 14:08 上传

点击文件名下载附件

1. Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
   
2. Function VbStrToMultiByte(VbStr As String) As Byte()
   
3.     Dim bufSize As Long
   
4.     Dim arr() As Byte
   
5.     bufSize = WideCharToMultiByte(65001, 0&, StrPtr(VbStr), Len(VbStr), 0, 0, 0, 0)
   
6.     ReDim arr(bufSize - 1)
   
7.     WideCharToMultiByte 65001, 0&, StrPtr(VbStr), Len(VbStr), arr(0), bufSize, 0, 0
   
8.     VbStrToMultiByte = arr
   
9.     '这几行代码以及上述API所起到的作用就是 手工另存为 UTF-8格式
   
10. End Function
    
11. 
    
12. Sub toANSI()                           '360助手 安卓系统 ANSI格式通过手机助手导入
    
13.     Dim s As String, b() As Byte, b1() As Byte, s1 As String
    
14. 
    
15.        For i = 2 To 89 '从第二行开始到第六行，根据实际情况修改
    
16. 
    
17.         s1 = s1 & "BEGIN:VCARD" & vbCrLf & "VERSION:3.0" & vbCrLf
    
18.         s1 = s1 & "CATEGORIES:" & Cells(i, 8) & vbCrLf
    
19.         s1 = s1 & "N:" & Cells(i, 1) & vbCrLf
    
20.         s1 = s1 & "TEL;TYPE=CELL:" & Cells(i, 2) & vbCrLf
    
21.         s1 = s1 & "TEL;TYPE=CELL:" & Cells(i, 3) & vbCrLf
    
22.         s1 = s1 & "TEL;TYPE=WORK:" & Cells(i, 4) & vbCrLf
    
23.         s1 = s1 & "TEL;TYPE=HOME:" & Cells(i, 5) & vbCrLf
    
24.         s1 = s1 & "EMAIL;TYPE=PREF:" & Cells(i, 6) & vbCrLf
    
25.         s1 = s1 & "ADR;TYPE=WORK:" & Cells(i, 7) & vbCrLf
    
26.         s1 = s1 & "END:VCARD" & vbCrLf
    
27.     Next
    
28.     b1 = StrConv(s1, 128)
    
29.     s = "c:\360手机助手导入.vcf"
    
30.     If Dir(s) <> "" Then Kill s
    
31.     Open s For Binary As 1
    
32.     Put 1, , b1
    
33.     Close
    
34. MsgBox s
    
35. 
    
36. End Sub
    
37. Sub toUTH8()   '' 安卓系统 Utf-8格式，直接存在手机卡中导入
    
38.     Dim s As String, b() As Byte, b1() As Byte, s1 As String
    
39.     For i = 2 To 89 '从第二行开始到第六行，根据实际情况修改
    
40. 
    
41.         s1 = s1 & "BEGIN:VCARD" & vbCrLf & "VERSION:3.0" & vbCrLf
    
42.         s1 = s1 & "CATEGORIES:" & Cells(i, 8) & vbCrLf '分组信息，某些机型会忽略此项，如果重要最好用手机助手导入
    
43.         s1 = s1 & "N:" & Cells(i, 1) & vbCrLf
    
44.         s1 = s1 & "TEL;TYPE=CELL:" & Cells(i, 2) & vbCrLf
    
45.         s1 = s1 & "TEL;TYPE=CELL:" & Cells(i, 3) & vbCrLf
    
46.         s1 = s1 & "TEL;TYPE=WORK:" & Cells(i, 4) & vbCrLf
    
47.         s1 = s1 & "TEL;TYPE=HOME:" & Cells(i, 5) & vbCrLf
    
48.         s1 = s1 & "EMAIL;TYPE=PREF:" & Cells(i, 6) & vbCrLf
    
49.         s1 = s1 & "ADR;TYPE=WORK:" & Cells(i, 7) & vbCrLf
    
50.         s1 = s1 & "END:VCARD" & vbCrLf
    
51.     Next
    
52.     b1 = VbStrToMultiByte(s1)  '
    
53.     '所有语句都相同，只是在这里进行格式转换 ，相当于手工另存为UTF-8格式
    
54. 
    
55.     s = "c:\直接存在手机卡中导入.vcf"
    
56.     If Dir(s) <> "" Then Kill s
    
57.     Open s For Binary As 1
    
58.     Put 1, , b1
    
59.     Close
    
60. MsgBox s
    
61. 
    
62. End Sub
    

复制代码

吼吼吼发放

API 那段加一个判断，本论坛搜索很多相关的帖子

Nsp=娜！再来#

吼吼吼发放 发表于 2018-10-3 19:06
API 那段加一个判断，本论坛搜索很多相关的帖子

加了，不成功

吼吼吼发放

Nsp=娜！再来# 发表于 2018-10-3 19:57
加了，不成功

没360通讯录，你自己测试下

Nsp=娜！再来#

吼吼吼发放 发表于 2018-10-3 20:13
没360通讯录，你自己测试下

成功，谢谢！