フォルダにショートカット作成

質問

Excel VBAを利用して、既に存在するフォルダにブックのショートカットを作りたいと思っております。

通常でしたら、

(1)作業中のブックを保存

(2)保存されているフォルダ（Ａ）内からブックのショートカットを作成

(3)目的とするフォルダ（Ｂ）へショートカットを移動

という手順になるかと思うのですが、これをマクロで処理したいと思っております。

自分なりに調べてはみましたが、VBA初心者のため上手くいきません。

いい方法がございましたら教えて頂けないでしょうか？よろしくお願いします。

回答No.2

puddingeater

> ActiveWorkbook.SaveAs Filename:=strBookPath
> に問題があるようでエラーが出てしまいます。

Excelのバージョンとエラーの内容を書いてもらえると助かります。
Excelの質問を投稿すると「回答者の第一声はいつもこれだな！」と鬱陶しくなるくらいよく訊かれるところですが、これがないと回答の幅が広がりすぎてしまいますので。

回答のコードをそのまま実行されているのでしょうか。
それでしたら strFolderA, strBookName , strFolderB , strFileName は質問者さんが想定されているフォルダ名・ファイル名に変えてください。

Excelのバージョンの記載が無くて初心者とおっしゃっているので最近のExcel (2007,2010) だろうと判断したのですが、その辺りはどうでしょうか。
バージョンによってExcelの見た目が変わるように、マクロも書き方の変わる箇所がでてきます。

バージョンによってファイル名の指定は変える必要があります。
ご存知かもしれませんが、一応書いておきます。
最近のExcelで「マクロなしのブック」だと".xlsx"で終わる名前にするところを古いExcelだと"xls"にしないとうまくいきません。
最近のExcelでも保存したいものが「マクロありのブック」だとxlsmでないとエラーが出ます。
(Excel 2007,2010 マクロ無しのブック) aaa.xlsx
(Excel 2007,2010 マクロ入りのブック) aaa.xlsm
(Excel 2002,2003) aaa.xls
もし仮に保存できたとしても内容と食い違っていると開くときに警告が出ることがあります。

strFolderA, strFolderB に指定したフォルダーが実際に見つからない場合も保存できないのでエラーになります。

質問に明記されていませんでしたが、ファイル名は毎回変えられるようにしたいということならGetSaveAsFilenameという関数を使うと保存ダイアログを出せるので便利です。
そのマクロを下に記載しておきますが、マクロ中に出てくる xlsx・xlsm はバージョン・ブック内容によっては書き換えが必要です（上述）。
-------------------------------------------------------
Sub SaveAndCreateShortcut()

'ブックを保存
strBookPath = Application.GetSaveAsFilename( _
fileFilter:="Excel ブック (*.xlsx), *.xlsx, Excel マクロ有効ブック (*.xlsm), *.xlsm", _
Title:="ブックの保存")
If strBookPath = False Then
MsgBox "保存取り消し"
Exit Sub
End If
ActiveWorkbook.SaveAs Filename:=strBookPath
ActiveWorkbook.Close

Set objShell = CreateObject("WScript.Shell")

'ショートカットの名前
strFileName = Application.GetSaveAsFilename( _
Title:="ショートカット名の指定")
If strFileName = False Then
MsgBox "ショートカット作成取り消し"
Exit Sub
End If
If Right(strFileName, 1) = "." Then
strFileName = strFileName & "lnk"
Else
strFileName = strFileName & ".lnk"
End If

'ショートカットのオブジェクトを作成
Set objShortCut = objShell.CreateShortcut(strFileName)

'ショートカットの指す先としてフォルダ（Ａ）内のブックを指定
objShortCut.TargetPath = strBookPath

'ショートカットを保存（実際に作成）
objShortCut.Save

Set objShortCut = Nothing
Set objShell = Nothing

End Sub
-------------------------------------------------------

回答No.1

puddingeater

VBAでショートカットを作成する例が見つけにくいのですかね。

WshShellオブジェクトというのを使って、(2)と(3)はまとめてできます。
日本語で言うなら、「（Ａ）内のブックのショートカットを（Ｂ）に作る」となります。

探せばVBAのコードそのものもあるのでしょうが、VBScriptのコードもかなり似ていて参考になります。
http://www.kanaya440.com/contents/tips/vbs/008.html
http://www.atmarkit.co.jp/fwin2k/operation/wsh06/wsh06_03.html
http://www.atmarkit.co.jp/fwin2k/tutor/cformwsh14/cformwsh14_02.html
http://msdn.microsoft.com/ja-jp/library/cc364400.aspx

一つ目のURLのがシンプルで分かりやすそう(VBAではないんですが)。
最後のはMicrosoftの説明ですが、こんなにたくさんオプションを指定しなくても普通は事足りるでしょう。

これらを参考にExcel VBAで書いたら、例えば次のような感じ。
（実行直前に作業中のブックがアクティブな状態になってる場合）

------------------------------------------

Sub SaveAndCreateShortcut()

'フォルダ（Ａ）にブックを保存
strFolderA = "C:\tmp\folder_A"
strBookName = "aaa.xlsx"
strBookPath = strFolderA & "\" & strBookName
ActiveWorkbook.SaveAs Filename:=strBookPath
ActiveWorkbook.Close

'WSHShell オブジェクトを作成
Set objShell = CreateObject("WScript.Shell")

'フォルダ（Ｂ）に作るショートカットの名前
strFolderB = "C:\tmp\folder_B"
strFileName = strFolderB + "\aaaのショートカット.lnk"

'ショートカットのオブジェクトを作成
Set objShortCut = objShell.CreateShortcut(strFileName)

'ショートカットの指す先としてフォルダ（Ａ）内のブックを指定
objShortCut.TargetPath = strBookPath

'ショートカットの内容を保存
objShortCut.Save

Set objShortCut = Nothing
Set objShell = Nothing

End Sub

------------------------------------------

補足

試しに行ってみましたが、序盤部分

ActiveWorkbook.SaveAs Filename:=strBookPath

に問題があるようでエラーが出てしまいます。

作業中のブックはもちろんアクティブになっていますし。。。