[問題] 如何快速在Excel編輯、建立vCard聯絡人

[i923 ()]

(若是和其他不同軟體互動之問題 請記得一併填寫)
軟體:Excel

版本:Microsoft 365


我現在有A欄:姓名；B欄:電子信箱，共500筆

現在用VBA輸出以下的文字

BEGIN:VCARD
VERSION:4.0
FN:01-王小明
EMAIL;TYPE=INTERNET;TYPE=WORK:[e-mail]
END:VCARD
BEGIN:VCARD
VERSION:4.0
FN:01-陳小花
EMAIL;TYPE=INTERNET;TYPE=WORK:[e-mail]
END:VCARD

但執行到幾十筆時跳出視窗顯示，
----------------------
執行階段錯誤'5':
程序呼叫或引述不正確
----------------------

以下是我VBA的寫法:

Sub Contacts()

Dim filepath, fso

    filepath = "C:\Users\admin\Desktop\Contacts.vcf"


Set fso = CreateObject("Scripting.FileSystemObject")
Set fileStream = fso.CreateTextFile(filepath)

intRow = 2
strName = ThisWorkbook.Sheets("工作表1").Range("A" & intRow).Text

While strName <> ""

strName = Trim(ThisWorkbook.Sheets("工作表1").Range("A" & intRow).Text)
strMail = Trim(ThisWorkbook.Sheets("工作表1").Range("B" & intRow).Text)

fileStream.WriteLine "BEGIN:VCARD"
fileStream.WriteLine "VERSION:4.0"
fileStream.WriteLine "FN:" & strName        ----------偵錯卡在這一行-------
fileStream.WriteLine "EMAIL;TYPE=INTERNET;TYPE=WORK:" & strMail
fileStream.WriteLine "END:VCARD"

intRow = intRow + 1
strName = ThisWorkbook.Sheets("工作表1").Range("A" & intRow).Text


Wend
fileStream.Close
If fso.FileExists(filepath) Then
MsgBox "完成"
End If

End Sub


請問我要如何修正呢?

--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 36.238.148.140 (臺灣)
※ 文章網址: https://www.ptt.cc/bbs/Office/M.1646374389.A.C0C.html
※ 編輯: i923 (36.238.148.140 臺灣), 03/04/2022 23:53:21
推 waiter337: 先偵錯 上面加一行debug.print strName
→ waiter337: 還有新增監看式strName 看看有沒有出現亂碼還是空值
→ waiter337: 看看debug.print出來是什麼
※ 編輯: i923 (36.238.148.140 臺灣), 03/05/2022 00:34:29
→ i923: 找到問題了，名字裡有異體字，改掉就完成了
→ i923: 但有辦法讓電腦認得異體字嗎?畢竟是名字
→ waiter337: https://ithelp.ithome.com.tw/articles/10158519?sc=r
→ waiter337: ss.iron
→ waiter337: 最下面的那段方式可以   目前的方式不行