iT邦幫忙

DAY 16
1

Excel VBA 的眉眉角角系列 第 16

Excel VBA 的眉眉角角Day16: 取得特殊路徑與UTF8檔案名稱寫入問題

這篇與上一篇是息息相關的,但因性質不同,所以我就分開討論了,關於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屬性


上一篇
Excel VBA 的眉眉角角Day15:關於寫入純文字檔的這檔事
下一篇
Excel VBA 的眉眉角角Day17: 匯入文字檔後逐行檢查
系列文
Excel VBA 的眉眉角角30

尚未有邦友留言

立即登入留言