こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBAでパス名(2バイト文字)のエラーを改善

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

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

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

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

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


パス名が1バイト文字なら問題ありません。
どのように指示をすれば良いのでしょうか?><;

調べたのですが、
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




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

投稿日時 - 2013-10-28 12:58:44

QNo.8324183

困ってます

質問者が選んだベストアンサー

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

投稿日時 - 2013-10-28 16:20:51

お礼

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


~最終的な記述~

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:13

このQ&Aは役に立ちましたか?

7人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

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

投稿日時 - 2013-10-28 13:38:39

お礼

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

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

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

投稿日時 - 2013-10-28 15:34:37

あなたにオススメの質問