這篇與上一篇是息息相關的，但因性質不同，所以我就分開討論了，關於Excel VBA是否支援Unicode的部份，其實支援程度有限，若要從程式裡產生Unicode的檔名，使用Open 陳述式配合Print與Write是不行的，一定得從上一篇提到的，使用ADODB.Stream才行。

另外，關於系統相關資料夾的取得，我們這裡也來做個介紹。

在命令列模式中，輸入set後，可以帶出現有系統的環境變數，其中有幾個是系統常用到的資料夾路徑，我們可以由VBA中，使用「Environ("變數名稱")」來取得變數資訊。但這還是不夠的，因為環境變數，並沒有把Windows的一些特殊資料夾列出，這時我們會使用Wscript.shell物件中的SpecialFolders屬性，帶出系統的特殊資料夾路徑。

以下程式為帶出系統特殊資料夾的子程式：

Function SpecialFolders(strFolder) As String
    '取得特殊資料夾路徑
    Dim myDesktopPath As String
    Dim WshShell As Object
    Set WshShell = CreateObject("Wscript.shell")
    SpecialFolders = WshShell.SpecialFolders(strFolder)
End Function

另外，由以下程式作為範例：

Sub Day16_1()
    '取得環境參數
    MsgBox Environ("ProgramFiles")
    MsgBox Environ("USERDOMAIN")
    
    '取得特殊資料夾路徑
    MsgBox SpecialFolders("Desktop")
    MsgBox SpecialFolders("Fonts")
End Sub

這樣即可得出各種相關路徑。

（其餘訊息窗省略抓圖）

另外，比如我們有一個多國語言的資料表如下：

當利用Open陳述式時寫法如下：

Sub Dya16_2()
    Sheets("Day16").Select
    Dim Rng As Object
    Dim strData
    
    On Error GoTo ErrZone
    
    For Each Rng In Range("A2:A6")
        Open SpecialFolders("Desktop") & "\" & Rng & ".txt" For Output As #1
        Print #1, Rng
        Close #1
    Next
    Debug.Print strData
    
    Exit Sub
    
ErrZone:
    Debug.Print Err.Number & ": " & Err.Description
    Resume Next
    
End Sub

產生在桌面的檔案：

使用Open方式寫入檔案，但Unicode的部份會出錯，只輸出3個文件，且均為目前系統語言(台灣中文、英文)

改用ADODB.Stream方式的程式：

Sub Day16_3()
    '多國語言文字寫入UTF8格式的文字檔，加上UTF8檔名
    Sheets("Day16").Select
    Dim Rng As Object
    Dim strData
    
    For Each Rng In Range("A2:A6")
        Dim fsT As Object
        Set fsT = CreateObject("ADODB.Stream")
        fsT.Type = 2 '指定類型，儲存文字資料使用2
        fsT.Charset = "UTF-8" '指定字元集為UTF8
        fsT.Open '開啟與寫入二進位資料到物件
        fsT.WriteText Rng
        fsT.SaveToFile SpecialFolders("Desktop") & "\" & Rng & ".txt", 2   '寫入二進位資料到磁碟
    Next
End Sub

產生出來的檔案：

這樣即可寫入正確的檔案名稱，解決了Unicode檔名的困擾。

有了昨天與今天的教學，相信在輸出純文字擋上有所助益，明天來談的讀取的部份，敬請期待。

參考網站：關於SpecialFolders屬性