システムの設定変更や取得にに関する質問をまとめました。

ディスプレイの解像度を変更するには
コンピュータ名を取得するには
バイナリコードをレジストリに設定・取得するには？
VBプログラムからフロッピーディスクのフォーマットをするには？
ファイルのバージョン情報や製品名、著作権を取得するには？
ショートカットを作成するには

Q ディスプレイの解像度を変更するには

VBのプログラムからのディスプレイの解像度を変更するにはどうしたら良いでしょうか？

A APIのChangeDisplaySettings を使用します

ディスプレイの解像度を変更するには、まず、現在設定できる解像度の情報を取得する必要があります。
設定できる解像度の情報を取得するには、EnumDisplaySettings というAPIを使用します。

■ 解像度の情報を取得するには

まず、標準モジュールに以下の宣言を入れます。

Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32

Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmLogPixels As Integer
    dmBitsPerPel As Long             'パレットのビット数
    dmPelsWidth As Long              '画面の幅
    dmPelsHeight As Long             '画面の高さ
    dmDisplayFlags As Long           '
    dmDisplayFrequency As Long  '周波数
    dmICMMethod As Long
    dmICMIntent As Long
    dmMediaType As Long
    dmDitherType As Long
    dmICCManufacturer As Long
    dmICCModel As Long
    dmPanningWidth As Long
    dmPanningHeight As Long
End Type

Public Const DM_GRAYSCALE = &H1
Public Const DM_INTERLACED = &H2

Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" ( _
    ByVal lpDeviceName As String, _
    ByVal iModeNum As Long, _
    lpDevMode As DEVMODE) As Long

解像度を取得する為に、以下のコードを実行します。

Dim lngIndex As Long
Dim dev(1000) As DEVMODE

lngIndex = 0&

Do While EnumDisplaySettings(vbNullString, lngIndex, dev(lngIndex)) <> 0
    lngIndex = lngIndex + 1
Loop

解像度の情報が dev() に入り、情報の数は、lngIndex に取得できます。

ここで、解像度の変更で必要な情報は、以下の５つの情報ですy。

■ 解像度を変更するには

まず、標準モジュールに以下の宣言を入れます。

'dmFields
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const DM_DISPLAYFLAGS = &H200000
Public Const DM_DISPLAYFREQUENCY = &H400000
'DM_POSITION は、Win98 WinNT5.0 から

'dwFlags
Public Const CDS_UPDATEREGISTRY = &H1&
Public Const CDS_TEST = &H2&
Public Const CDS_FULLSCREEN = &H4&
Public Const CDS_GLOBAL = &H8&
Public Const CDS_SET_PRIMARY = &H10&
Public Const CDS_RESET = &H40000000
Public Const CDS_NORESET = &H10000000

Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" ( _
    lpDevMode As Any, _
    ByVal dwFlags As Long) As Long

' ChangeDisplaySettings からの戻り値
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Public Const DISP_CHANGE_FAILED = -1
Public Const DISP_CHANGE_BADMODE = -2
Public Const DISP_CHANGE_NOTUPDATED = -3
Public Const DISP_CHANGE_BADFLAGS = -4
Public Const DISP_CHANGE_BADPARAM = -5

解像度を取得する為に、以下のコードを実行します。

r& = ChangeDisplaySettings(dev(i), 0)

dev(i) は、 EnumDisplaySettings で取得した解像度の情報を設定します。２番目のパラメータにの dwFlags には以下の値を設定します。

ChangeDisplaySettings の戻り値は、以下の通りです。

変更する解像度の設定を限定したい場合は、dev(i) の dmFields に指定したい項目のフラグを設定してEnumDisplaySettings を呼んでください。

'画面の幅と高さのみ変更
dev(i).dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

また、dwFlags ０を設定した場合や一時的に設定を変更した場合は、以下のように、第一引数を ByVal 0& 、 第二引数に0 を指定すれば、元の解像度に戻る事ができます。

ChangeDisplaySettings ByVal 0&, 0

（注意）Win95 では、現在設定されてる色数から別の色数には変更できません。

（注意）このページの内容は、Visual Basic5.0(SP3) を対象に記述されています。他のバージョンでは、対応できないこともあるので、ご注意願います。
（注意）ここでの情報については、あくまでも各自の責任にて、充分にテストを行ってご使用ください。内容に関する質問については、回答できる保証がありませんので、予めご了承願います

Q コンピュータ名を取得するには

コントロールパネルで設定したコンピュータ名を取得するにはどうしたらよいのですか？

A APIの GetComputerName または WSH のオブジェクトを使用します

コンピュータ名を取得する方法は、大きく分けてＡＰＩを使用する方法と、WSH (Windows Script Host)のオブジェクトを使用する方法があります。ＡＰＩを使用する場合は、ＡＰＩの宣言等が面倒ですが、環境に依存しないコードが作成できます。一方、WSH を使用する場合、ＡＰＩの宣言等は不要で手軽にコードを作成できるのですが、反面、WSH がインストールされている環境でなければ使用できません。

■ ＡＰＩを使用する場合

コンピュータ名を取得する ＡＰＩ は GetComputerName を使用すれば取得できますが、１つだけ注意することがあります。コンピュータ名を取得する時バッファーのサイズを指定する MAX_COMPUTERNAME_LENGTH という定数が ＡＰＩビューアに現れません。このサイズは、Visual C++ の ヘッダーファイルを検索すると以下のように定義されてます。

#define MAX_COMPUTERNAME_LENGTH 15

これを、ＶＢで宣言するには、以下の宣言を標準モジュールに入れます。

Public Const MAX_COMPUTERNAME_LENGTH = 15

Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long

これで、以下のようにコンピュータ名が取得できます。

Dim strBuf As String

strBuf = Space(MAX_COMPUTERNAME_LENGTH + 1)
GetComputerName strBuf, MAX_COMPUTERNAME_LENGTH

'ラベルにコンピュータ名を表示
lblName.Caption = strBuf

また、この strBuf の内容は、Ｃ言語で使用する NULL文字（Chr$(0)）で終了する文字列になっているので、コンピュータ名の後ろに Chr$(0)と空白が付加されています。ＶＢで扱い易いように、このChr$(0)以降の文字を以下のように削除します。

Dim strBuf As String
Dim intPos As Integer

strBuf = Space(MAX_COMPUTERNAME_LENGTH + 1)
GetComputerName strBuf, MAX_COMPUTERNAME_LENGTH

'Chr$(0)以降の文字を削除
intPos = InStr(strBuf, Chr$(0))
If intPos > 0 Then
    strBuf = Left$(strBuf, intPos - 1)
End If

'ラベルにコンピュータ名を表示
lblName.Caption = strBuf

■ ＷＳＨを使用する場合

WSH を使用する場合のコードは簡単です。

Dim WshNetwork As Object
Dim strComputerName As Object

Set WshNetwork = CreateObject("WScript.Network")

strComputerName = WshNetwork.ComputerName
MsgBox strComputerName

Set WshNetwork = Nothing

見ても分かる通り、CreateObject で "WScript.Network" のオブジェクトを WshNetwork に作成して、WshNetwork のComputerNameプロパティを参照するだけです。
同様に WshNetwork のプロパティには、以下のようなプロパティがあります。

（注意）ＷＳＨを使用する場合には、以下の環境のいずれかが必要です。

・Internet Explorer の 5.0 以上
・Windows NT 4.0 のOption Pach
・Windows 98
・ＭＳのサイトよりWSHをダウンロードしてインストール

詳細に付いては以下を参照してください。
http://www.asia.microsoft.com/Japan/Developer/Scripting/

（注意）このページの内容は、Visual Basic5.0(SP3) 、Visual Basic6.0(SP3)を対象に記述されています。他のバージョンでは、対応できないこともあるので、ご注意願います。
（注意）ここでの情報については、あくまでも各自の責任にて、充分にテストを行ってご使用ください。内容に関する質問については、回答できる保証がありませんので、予めご了承願います

Q バイナリコードをレジストリに設定・取得するには？

バイナリのデータをレジストリに設定・取得するにはどうすれば良いのですか？

A APIを使用すれば案外簡単にできます

バイナリのレジストリの設定、取得は API を使用すれば案外簡単にできます。設定・取得方法は、次の通りです。

■ バイナリのレジストリの設定
1. RegCreateKey で、親キーとサブキーを指定して、サブキーまでを作成 します。この時、ハンドルとなる hKey を受け取ります。
2. RegSetValueEx で  hKey 、キー、値を指定して、データを書き込みます。   このとき、データのタイプに REG_BINARY を指定すればバイナリとなります。
3. RegCloseKey で  hKey を渡してクローズします。

■ バイナリのレジストリの取得
1. RegOpenKeyで、親キーとサブキーを指定して、オープンします。   この時、ハンドルとなる hKey を受け取ります。
2. RegQueryValueExで  hKey 、キー、値を指定して、データを取得します。   また、取得したデータのタイプも返されます。
3. RegCloseKey で  hKey を渡してクローズします。

以下は、サンプルです。データは、バイト型の配列を使用してますが、
String 型だと、Unicode と Shift Jis の変換が発生するので、バイト型を使用した方が安全です。

'バイナリのレジストリの取得
Private Sub cmdRegGet_Click()
    Dim r As Long
    Dim hKey As Long
    Dim bData(9) As Byte
    Dim i As Integer
    Dim lngType As Long

    '引数： 主キー、サブキー、hKey
    r = RegOpenKey(HKEY_CURRENT_USER, "MyData", hKey)
    If r <> ERROR_SUCCESS Then
        MsgBox "RegOpenKey Error"
        Exit Sub
    End If

    '引数： hKey、キー、0 固定、取得したデータのタイプ、バイト列の先頭アドレス、サイズ
    r = RegQueryValueEx(hKey, "BinaryData", 0&, lngType, bData(0), 10)
    If r <> ERROR_SUCCESS Or lngType <> REG_BINARY Then
        MsgBox "RegQueryValueEx Error"
        Exit Sub
    End If

   '引数： hKey
    RegCloseKey hKey

    For i = 0 To 9: Debug.Print bData(i): Next

End Sub

'バイナリのレジストリの設定
Private Sub cmdRegSet_Click()
    Dim r As Long
    Dim hKey As Long
    Dim bData(9) As Byte
    Dim i As Integer
   
    '引数： 主キー、サブキー、hKey
    r = RegCreateKey(HKEY_CURRENT_USER, "MyData", hKey)
    If r <> ERROR_SUCCESS Then
        MsgBox "RegCreateKey Error"
        Exit Sub
    End If

    For i = 0 To 9: bData(i) = i: Next

   '引数： hKey、キー、0 固定、REG_BINARY、バイト列の先頭アドレス、サイズ
    r = RegSetValueEx(hKey, "BinaryData", 0&, REG_BINARY, bData(0), 10)
    If r <> ERROR_SUCCESS Then
        MsgBox "RegSetValueEx Error"
        Exit Sub
    End If

   '引数： hKey
    RegCloseKey hKey

End Sub

以下は、宣言部です。標準モジュールに入れてください。

Option Explicit

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Public Const ERROR_SUCCESS = 0&
Public Const ERROR_NO_MORE_ITEMS = 259&

Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4

Declare Function RegCreateKey Lib "advapi32" Alias "RegCreateKeyA" ( _
    ByVal hKey As Long, _
    ByVal lpszSubKey As String, _
    phkResult As Long) As Long

Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" ( _
    ByVal hKey As Long, _
    ByVal lpszSubKey As String, _
    phkResult As Long) As Long

Declare Function RegCloseKey Lib "advapi32" ( _
    ByVal hKey As Long) As Long

Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" ( _
    ByVal hKey As Long, _
    ByVal lpszSubKey As String) As Long

Declare Function RegEnumKey Lib "advapi32" Alias "RegEnumKeyA" ( _
    ByVal hKey As Long, _
    ByVal iSubKey As Long, _
    ByVal lpszName As String, _
    ByVal cchName As Long) As Long

Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpszValueName As String, _
    ByVal dwReserved As Long, _
    ByVal fdwType As Long, _
    lpbData As Any, _
    ByVal cbData As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpszValueName As String, _
    ByVal dwReserved As Long, _
    lpdwType As Long, _
    lpbData As Any, _
    cbData As Long) As Long

（注意）このページの内容は、Visual Basic5.0(SP3) を対象に記述されています。他のバージョンでは、対応できないこともあるので、ご注意願います。
（注意）ここでの情報については、あくまでも各自の責任にて、充分にテストを行ってご使用ください。内容に関する質問については、回答できる保証がありませんので、予めご了承願います。

Q VBプログラムからフロッピーディスクのフォーマットをするには？

ＶＢのプログラムから、フロッピーディスクのフォーマットを行うにはどうしたらよいでしょうか？

A API の SHFormatDrive でできます

ＡＰＩ の SHFormatDrive は、以下のようなパラメータを持っています。

Declare Function SHFormatDrive Lib "shell32" ( _
    ByVal hwnd As Long, _
    ByVal drive As Long, _
    ByVal fmtID As Long, _
    ByVal options As Long) As Long

各パラメータの意味は次の通りです。

戻り値は、フォーマットの最後のステータスを返します。

ただし、私が ＮＴ４．０（ＳＰ４）、ＶＢ５．０（ＳＰ３）で実験したところ、エラーの場合は SHFMT_ERROR しかか返りませんでした（＾＾；

それでは、サンプルです。

Dim lngDrive As Long
Dim r As Long

lngDrive = 0      ' 0 -- A Drive, 1 -- B Drive, 2 -- C Drive ....
r = SHFormatDrive(Me.hwnd, lngDrive, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICK)

Select Case r
Case SHFMT_ERROR
    MsgBox ("ドライブフォーマット中にエラーが発生しました")
Case SHFMT_CANCEL
    MsgBox ("キャンセルが選択されました")
Case SHFMT_NOFORMAT
    MsgBox ("指定されたドライブはフォーマット不能です")
End Select

また、SetErrorMode というＡＰＩを使用すると、ＯＳの致命的なエラーに関するメッセージボックスを表示するかしないかを、指定することができます。

●致命的なエラーを表示させない場合。

Dim OldMode As Long

OldMode = SetErrorMode(0)   '以前のモードを保存
SetErrorMode (OldMode Or SEM_FAILCRITICALERRORS)
    ：
SHFormatDriveを実行
    ：
SetErrorMode OldMode             '以前のモードに戻す

●致命的なエラーを表示させる場合。

Dim OldMode As Long

OldMode = SetErrorMode(0)   '以前のモードを保存
SetErrorMode (OldMode And Not SEM_FAILCRITICALERRORS)
    ：
SHFormatDriveを実行
    ：
SetErrorMode OldMode          '以前のモードに戻す

以下は、宣言部です。標準モジュールに入れてください。

Public Const SHFMT_OPT_QUICK = &H0&
Public Const SHFMT_OPT_FULL = &H1&
Public Const SHFMT_OPT_SYSONLY = &H2&

Public Const SHFMT_ID_DEFAULT = &HFFFF

Public Const SHFMT_NOFORMAT = -3&
Public Const SHFMT_CANCEL = -2&
Public Const SHFMT_ERROR = -1&

Declare Function SHFormatDrive Lib "shell32" ( _
    ByVal hwnd As Long, _
    ByVal drive As Long, _
    ByVal fmtID As Long, _
    ByVal options As Long) As Long

Public Const SEM_FAILCRITICALERRORS = &H1&

Declare Function SetErrorMode Lib "kernel32" ( _
    ByVal wMode As Long) As Long

（注意） このページの内容は、Visual Basic5.0(SP3) を対象に記述されています。他のバージョンでは、対応できないこともあるので、ご注意願います。
（注意） ここでの情報については、あくまでも各自の責任にて、充分にテストを行ってご使用ください。内容に関する質問については、回答できる保証がありませんので、予めご了承願います。

Q ファイルのバージョン情報や製品名、著作権を取得するには？

エクスプローラでファイルのＤＬＬやＥＸＥのプロパティを見ると、ファイルのバージョンや、製品名、著作権といった情報が見られますが、ＶＢからそれらの情報を取得するにはどうしたらよいでしょうか？

A GetFileVersionInfo、VerQueryValue といったＡＰＩで取得できます

ファイルのバージョン情報は、以下のような GetFileVersionInfo、VerQueryValue で取得できます。

Dim lngRet As Long
Dim lngDummy As Long
Dim bBuffer() As Byte
Dim lngLen As Long
Dim lpBuffer As Long
Dim ffi As VS_FIXEDFILEINFO

' strFileName に取得したいファイル名をセット
strFileName = "OLEAUT32.DLL"

' サイズを取得
lngLen = GetFileVersionInfoSize(strFileName, lngDummy)
If lngLen < 1 Then
    Exit Sub
End If

' バイトの配列の領域取得
ReDim bBuffer(lngLen)

' ファイル バージョン情報を取得
lngRet = GetFileVersionInfo(strFileName, 0&, lngLen, bBuffer(0))
lngRet = VerQueryValue(bBuffer(0), "\", lpBuffer, lngLen)

' バイトの処理
MoveMemory ffi, lpBuffer, Len(ffi)

' ファイル バージョン
Debug.Print "FileViersion = " & _
Format$(ffi.dwFileVersionMSh) & "." & _
Format$(ffi.dwFileVersionMSl) & "." & _
Format$(ffi.dwFileVersionLSh) & "." & _
Format$(ffi.dwFileVersionLSl)

' 製品バージョン
Debug.Print "ProductVersion = " & _
Format$(ffi.dwProductVersionMSh) & "." & _
Format$(ffi.dwProductVersionMSl) & "." & _
Format$(ffi.dwProductVersionLSh) & "." & _
Format$(ffi.dwProductVersionLSl)

ここで、ポイントになるのが、VerQueryValue の２番目のパラメータに "\" を指定していることです。この場合、３番目のパラメータの lpBuffer という Long型の変数に、バージョン情報の構造体(VS_FIXEDFILEINFO)の先頭アドレスを返します。

製品名、著作権の取得は、以下のように VerQueryValue の引数に "\VarFileInfo\Translation" というパラメータを設定して、取得します。

Dim strFileName As String
Dim lngRet As Long
Dim lngDummy As Long
Dim bBuffer() As Byte
Dim lngLen As Long
Dim lpBuffer As Long
Dim cp As CODEPAGE
Dim strPath As String

' strFileName に取得したいファイル名をセット
strFileName = "OLEAUT32.DLL"

' サイズを取得
lngLen = GetFileVersionInfoSize(strFileName, lngDummy)
If lngLen < 1 Then
    Exit Sub
End If

' バイトの配列の領域取得
ReDim bBuffer(lngLen)

' ファイル バージョン情報を取得
lngRet = GetFileVersionInfo(strFileName, 0&, lngLen, bBuffer(0))
lngRet = VerQueryValue(bBuffer(0), "\VarFileInfo\Translation", lpBuffer, lngLen)

' 文字列情報の設定
MoveMemory cp, lpBuffer, lngLen
strPath = "\StringFileInfo\" & Right$("0000" & Hex$(cp.lngLOW), 4) & Right$("0000" & Hex$(cp.lngHIGH), 4) & "\"

Dim strProductName As String
Dim strLegalCopyright As String

'製品名の取得
lngRet = VerQueryValue(bBuffer(0), strPath & "ProductName", lpBuffer, lngLen)
strProductName = Space(lngLen)
MoveMemory ByVal strProductName, lpBuffer, lngLen

'著作権の取得
lngRet = VerQueryValue(bBuffer(0), strPath & "LegalCopyright", lpBuffer, lngLen)
strLegalCopyright = Space(lngLen)
MoveMemory ByVal strLegalCopyright, lpBuffer, lngLen

最初のVerQueryValueでは、lpBuffer に言語ＩＤといわれる４バイトの数値の先頭アドレスを返します。この４バイトの数値を使って、VerQueryValue を再度呼び出すと製品名や著作権情報が取得できます。この時、２番目のパラメータは以下のような形式で指定します。

\StringFileInfo\lang-code\string-name

従って、上記プログラムでは、以下の ProductName の部分を代えることによって各情報が取得できます。

'製品名の取得
lngRet = VerQueryValue(bBuffer(0), strPath & "ProductName", lpBuffer, lngLen)

以下は、宣言部です。標準モジュールに入れてください。

Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer
    dwStrucVersionh As Integer
    dwFileVersionMSl As Integer
    dwFileVersionMSh As Integer
    dwFileVersionLSl As Integer
    dwFileVersionLSh As Integer
    dwProductVersionMSl As Integer
    dwProductVersionMSh As Integer
    dwProductVersionLSl As Integer
    dwProductVersionLSh As Integer
    dwFileFlagsMask As Long
    dwFileFlags As Long
    dwFileOS As Long
    dwFileType As Long
    dwFileSubtype As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type

Type CODEPAGE
    lngLOW As Integer
    lngHIGH As Integer
End Type

Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" ( _
    ByVal lptstrFilename As String, _
    ByVal dwHandle As Long, _
    ByVal dwLen As Long, _
    lpData As Any) As Long

Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" ( _
    ByVal lptstrFilename As String, _
    lpdwHandle As Long) As Long

Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" ( _
    pBlock As Any, _
    ByVal lpSubBlock As String, _
    lplpBuffer As Any, _
    puLen As Long) As Long

Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    dest As Any, _
    ByVal Source As Long, _
    ByVal length As Long)

（注意） このページの内容は、Visual Basic5.0(SP3) を対象に記述されています。他のバージョンでは、対応できないこともあるので、ご注意願います。
（注意） ここでの情報については、あくまでも各自の責任にて、充分にテストを行ってご使用ください。内容に関する質問については、回答できる保証がありませんので、予めご了承願います。

Q ショートカットを作成するには

デスクトップなどに、プログラムのショートカットを作成するにはどうしたら良いのですか？

A WSH のオブジェクトを使用すればできます

ショートカットを作成するには、WSH (Windows Script Host)のオブジェクトを使用すればできます。WSH を使用する場合、ＡＰＩの宣言等は不要で手軽にコードを作成できるのですが、反面、WSH がインストールされている環境でなければ使用できません。WSH を使用しない場合は、IShellLink というインターフェースを使用するタイプライブラリが必用です。（やり方は、後日時間があったら作成します ＾＾；）

さっそくサンプルを見てみましょう。

Dim WshShell As Object
Dim oShellLink As Object
Dim strDesktop As String

Set WshShell = CreateObject("WScript.Shell")

strDesktop = WshShell.SpecialFolders("Desktop")
Set oShellLink = WshShell.CreateShortcut(strDesktop & "\メモ帳.lnk")
oShellLink.TargetPath = "notepad"
oShellLink.IconLocation = "notepad.exe,0"
oShellLink.Save

Set oShellLink = Nothing
Set WshShell = Nothing

1. 最初の CreateObjec で WshShell という ＷＳＨ のオブジェクトを作成しています。

2. WshShell のメソッドの SpecialFolders メソッドで、Desktop のパス名を取得します。SpecialFolders の引数には、以下のような引数が使用できます。

引数	使用できる Windows のバージョン
AllUsersDesktop	Windows NT
AllUsersStartMenu	Windows NT
AllUsersPrograms	Windows NT
AllUsersStartup	Windows NT
Desktop	Windows NT/95/98
Favorites	Windows NT/95/98
Fonts	Windows NT/95/98
MyDocuments	Windows NT/95/98
NetHood	Windows NT/95/98
PrintHood	Windows NT/95/98
Programs	Windows NT/95/98
Recent	Windows NT/95/98
SendTo	Windows NT/95/98
StartMenu	Windows NT/95/98
Templates	Windows NT

3.WshShell のメソッドの CreateShortcut で パス名の strDesktop を指定して、メモ帳の lnk ファイル名を指定します。これで、oShellLink という ショートカット作成用のオブジェクトが作成されます。

4.作成された oShellLink のプロパティを設定して、ショートカットのファイル名、アイコン等を設定します。プロパティとプロパティの使い方は次の通り。

プロパティ	使い方
Description	記述を設定します。
FullName	フルパス名を返します（読込み専用）。
Hotkey	ショートカットキーを設定します。以下の文字列を組み合わせます。 "ALT+" | "CTRL+" | "SHIFT+" | "EXT+" "A" .. "Z" | "0".. "9" | "Back" | "Tab" | "Clear" | "Return" | "Escape" | "Space" | "Prior" | ...
IconLocation	アイコンのファイル名と何番目のアイコンかを "," で区切って指定します。
TargetPath	目的となるファイル名を指定します。
WindowStyle	Window のスタイルを設定 1 -- アクティブにしてウィンドウを表示します。元のウィンドウが、最大化、最小化されている場合は、元の状態でウィンドウを表示します。 3 -- アクティブにしてウィンドウを最大化表示します。 7 --最小化して、次のトップレベルのウィンドウをアクティブにします。

5.oShellLink の Save メソッドでショートカットを保存します。

6.最後に不要になったオブジェクトを削除します。

（注意）ＷＳＨを使用する場合には、以下の環境のいずれかが必要です。

・Internet Explorer の 5.0 以上
・Windows NT 4.0 のOption Pach
・Windows 98
・ＭＳのサイトよりWSHをダウンロードしてインストール

詳細に付いては以下を参照してください。
http://www.asia.microsoft.com/Japan/Developer/Scripting/

（注意）このページの内容は、Visual Basic5.0(SP3) 、Visual Basic6.0(SP3)を対象に記述されています。他のバージョンでは、対応できないこともあるので、ご注意願います。
（注意） ここでの情報については、あくまでも各自の責任にて、充分にテストを行ってご使用ください。内容に関する質問については、回答できる保証がありませんので、予めご了承願います。