VBAでパス名（２バイト文字）のエラーを改善

質問

エクセルVBAでPDFを作成したい<http://okwave.jp/qa/q8318460.html >
の派生質問になります。

エクセル2000　Windows7の環境下で
CubePDFというアプリケーションをVBAで操作しています。
出力ファイルに保存したいファイル名をいれるのですが、
ひらがなカタカナ漢字などの２バイト文字がパス名にあると
うまくコピペできません。

例）
↓で保存したい
　～～\Desktop\新しいフォルダー\12345.pdf

↓アプリケーション内
出力ファイル
　～～\Desktop\V6{tH_[\12345.pdf

↓メッセージ
×CubePDF エラー
パスの一部が見つかりません。

パス名が１バイト文字なら問題ありません。
どのように指示をすれば良いのでしょうか？＞＜；

調べたのですが、
Unicode？Shift_JIS に自動で対応してくれない？B付きの関数？URL形式でエンコード？
等々、初心者には？？？の連続で。。。

VBAはA1セルにあるパス名（ファイル名）でPDFを作成保存するVBAです。

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long

Sub PDF作成()

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="CubePDF on Ne05:"
'↑ActivePrinter:="ここを変える"　マクロの記録などで確認　<プリンタの設定>

Do
cuHw = FindWindow(vbNullString, "CubePDF 1.0.0RC4 (x86)")
Loop While cuHw = 0
'↑CubeBDFのウインドーが開いたかどうかを確認（この段階ではまだアクティブになるまで若干間がある）

SetForegroundWindow cuHw
'↑CubeBDFのウィンドーをアクティブ化

Dim Fname As String
Fname = Range("A1") 'ファイル名を取得

PresentPrinter = Application.ActivePrinter
With CreateObject("Wscript.Shell")　'保存先の所まで移動して名前をつける
.SendKeys "{TAB}"
.SendKeys "{TAB}"
.SendKeys "{TAB}"
.SendKeys "{TAB}"
.SendKeys "{TAB}"
.SendKeys Fname
.SendKeys "{ENTER}"
End With
Application.ActivePrinter = PresentPrinter
End Sub

質問内容に不明な点がありましたら、補足説明させていただきますので、
よろしくお願いいたします。

回答No.2

Picosoft · ベストアンサー

CubePDFは使っていないので動作検証はしていませんが、
これでいかがでしょうか？

With CreateObject("Wscript.Shell")　'保存先の所まで移動して名前をつける
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.Run "%COMSPEC% /c echo " & Fname & "| clip", 0, True 'クリップボードにFnameをコピー
　.SendKeys "^v" '貼り付け
　.SendKeys "{ENTER}"
End With

お礼

ありがとうございます！！！解決いたしました！＾＾
これで作業時間が圧倒的に短縮されますっ！
細かくお教えいただきまして、本当にありがとうございました！

～最終的な記述～

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Declare Function SetForegroundWindow Lib "user32" _
(ByVal hwnd As Long) As Long

Sub PDF作成()

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, ActivePrinter:="CubePDF on Ne05:"
'↑ActivePrinter:="ここを変える"　マクロの記録などで確認　<プリンタの設定>

Do
cuHw = FindWindow(vbNullString, "CubePDF 1.0.0RC4 (x86)")
Loop While cuHw = 0
'↑CubeBDFのウインドーが開いたかどうかを確認（この段階ではまだアクティブになるまで若干間がある）

SetForegroundWindow cuHw
'↑CubeBDFのウィンドーをアクティブ化

Dim Fname As String
Fname = Range("A1") 'ファイル名を取得

PresentPrinter = Application.ActivePrinter
With CreateObject("Wscript.Shell")　'保存先の所まで移動して名前をつける
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.SendKeys "{TAB}"
　.Run "%COMSPEC% /c echo " & Fname & "| clip", 0, True 'クリップボードにFnameをコピー
　.SendKeys "^v" '貼り付け
　.SendKeys "{ENTER}"
End With
Application.ActivePrinter = PresentPrinter
End Sub

回答No.1

Picosoft

SendKeysで日本語は送れません。
クリップボードを経由して貼り付ける方法を試してみてください。

お礼

ありがとうございます＾＾

すみません。。。Copyすればいいと思うのですが、
どの部分でcopy等々すればいいのでしょうか？＞＜；
CUBEが立ち上がるとクリップボードが消えてしまったりして
切り替えがうまいこといきませんTT

恐らくこのあたりの内容じゃないかとは思っているのですが。。。
http://oshiete.goo.ne.jp/qa/4639824.html
お教えいただけないでしょうか＞＜