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

エクセルVBAでPDFを作成したい<http://oshiete.goo.ne.jp/qa/8318460.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 回答日時： 2013/10/28 16:20

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

お礼日時：2013/10/28 17:13

No.1 回答者： Picosoft 回答日時： 2013/10/28 13:38

SendKeysで日本語は送れません。

クリップボードを経由して貼り付ける方法を試してみてください。

この回答へのお礼

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

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

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

お礼日時：2013/10/28 15:34