Unicodeを含む文字列のフォルダを作成したい。

Question

Unicodeを含む文字列のフォルダを作成したい。

独学でVBAを勉強して、社内のエクセルの便利化を図っているものです。

氏名に「茢なにがし」さんがおりその方の名前のフォルダをVBAで
作ろうとしたときに、茢→?となってしまい「実行エラー76　パスが見つかりません」
となってしまいます。

このような方の名前のフォルダを作るにはどうしたらよいでしょうか？

該当のソースコード

Range("A1").value = 茢なにがし
とします。

Sub tesuto()

Dim c As String
Dim d As String

c = Range("A1").Value

d = "C:\Users\user\Desktop\" & c

MkDir d 'ここでエラーとなる

'Range("A2").Value = c　'ためしにA2へ文字をいれると、普通に茢なにがしとなる

'ActiveSheet.Hyperlinks.Add Anchor:=Range("A2"), Address:=d　
'ハイパーリンクも同様につきました

End Sub

補足情報（FW/ツールのバージョンなど）

環境はWindows10 Microsoft 365 のエクセルです。
本来は、特定のセルの文字のフォルダを作って、そのフォルダのリンクを張るという
プログラムなのですが、上記のように特定(Unicode？)の文字がはいった方の
フォルダを作ろうとすると?になってしまい、それがWinの使用不可文字にひっかかり
フォルダが作成できない(パスがみつからない)ようです。

とりあえずReplace関数
Replace(c, "?", "")を試しましたが、
茢→?となっている部分は普通の?としては認識されておらず、
だめだったとおもいます。(A2に文字を返したのはその確認のため)

会社で使いたいので、Win10エクセルが絶対の環境で
以上の問題がどうにかなりますでしょうか…？

Answer 1

これでどうでしょう。
VBAのエディタ・デバッガはUnicode非対応なので、Shift_JISで表示出来ない文字は"?"に化けます。

Option Explicit

Private Declare PtrSafe Function CreateDirectoryW Lib "kernel32.dll" ( _
    ByVal stringlpPathName As LongPtr, _
    ByVal lpSecurityAttributes As LongPtr) As Integer

'CreateDirectoryWを使う方法
Private Sub MkDirUnicodeAPI(ByVal path As String)
    Call CreateDirectoryW(StrPtr(path), 0)
End Sub

'FileSystemObjectを使う方法
Private Sub MkDirUnicodeFSO(ByVal path As String)
    On Error Resume Next
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Call fs.CreateFolder(path)
    Set fs = Nothing
End Sub

Private Sub CommandButton1_Click()
    Dim c As String
    Dim d As String
    
    c = Range("A1").Value
    
    MkDirUnicodeAPI "C:\test\" & c & "_API"
    MkDirUnicodeFSO "C:\test\" & c & "_FSO"
End Sub

他関数も対応していないものがありそうな気がしますし、別アプリでもUnicode非対応のものは割とあるので、本当にそういった文字をファイルパスに含めていいのかどうかは良く考えてください。

Comments

[rasurabu]

ありがとうございます！
見よう見まねですが、本来のシステムに組み込むこともできました。

正直、前半はよくわかっていませんが…
そこは精進していこうと思います。

懸念されている、文字をファイルパスに～ということですが
基本ワンオフのプログラムで、拡張性は考慮していません。
環境もWin＋エクセルに縛られているので
たちまちは大丈夫かなと思います。

この度はありがとうございました。