ExcelVBAでフォルダーからファルイ名を書き出しリンクを貼り、表示名を変える

質問

下記のようなVBAをつくったのですがうまく行きません。
Option Explicit
Dim ドライブ As String
Dim フォルダ As String
Dim 拡張子 As String
Dim 記入シート As String
Dim パス As String
Dim ファイル名 As String
Dim ディスプレイ As String　
Dim 貼付行 As Integer
Dim ハイパーリンク As String
Dim strVal As Variant
'Sub フォルダ中のファイル名をシートに書く()
ドライブ = "C" 'ドライブを指定する
フォルダ = "M．Co，\My Documents"
拡張子 = "*." & "JPG"
記入シート = "ファイル一覧"
End Sub
Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
Sheets(記入シート).Activate Cells.Clear 'すべてクリア
Range("A1").Select
パス = ドライブ & ":\" & フォルダ & "\" 'パスを組む
ファイル名 = Dir(パス & 拡張子)
strVal = Dir(パス & 拡張子)
(1)ディスプレイ = Left(strVal, "SEARCH(""."",strVal)-1")
貼付行 = 0
　　 Do While ファイル名 <> ""
　　 貼付行 = 貼付行 + 1
Cells(貼付行, 1).Value = ファイル名 ActiveSheet.Hyperlinks.Add Anchor:=Cells(貼付行, 1), Address:=ファイル名, TextToDisplay:=ディスプレイ
ファイル名 = Dir() '次のファイル名を取り出す
Loop
End Sub
(1)がおかしいです。よろしくお願い致します。

回答No.1

BLUEPIXY · ベストアンサー

＞ディスプレイ = Left(strVal, "SEARCH(""."",strVal)-1")
要するに拡張子以降を取り除く処理ですよね。

ディスプレイ = Left(strVal, InStr(strVal, ".")-1)

みたいな感じにすればイイと思います。
あと、
＞strVal = Dir(パス & 拡張子)
みたいにDir( ) をもう一度実行するとおかしなことになります。
＞Cells(貼付行, 1).Value = ファイル名
は要らないと思います。
あと、前にも指摘がありましたが、
＞Range("A1").Select
もこの場合不要です。
修正版
Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
Sheets(記入シート).Activate
Cells.Clear 'すべてクリア
'Range("A1").Select
パス = ドライブ & ":\" & フォルダ & "\" 'パスを組む
ファイル名 = Dir(パス & 拡張子)
貼付行 = 0
Do While ファイル名 <> ""
貼付行 = 貼付行 + 1
ディスプレイ = Left(ファイル名, InStr(ファイル名, ".") - 1)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(貼付行, 1), Address:=ファイル名, TextToDisplay:=ディスプレイ
ファイル名 = Dir() '次のファイル名を取り出す
Loop
End Sub

お礼

絶対パスにすれば解決しました。
ありがとうございました。

補足

いつもすみません。さっそくのご返答ありがとうございます。
やってみましたが、表示名はうまく行きましたが
リンクがきれてしまいました。
リンクもファイル名に拡張子がついた状態にかわってしまいます。
例)表示文字列⇒Dec08294 , アドレス⇒Dec08294.JPG
と言う風になります。
コードは下記のように変更しました。
Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
Sheets(記入シート).Activate Cells.Clear
Range("A1").Select
パス = ドライブ & ":\" & フォルダ & "\"
ファイル名 = Dir(パス & 拡張子)
貼付行 = 0
Do While ファイル名 <> ""
貼付行 = 貼付行 + 1
ディスプレイ = Left(ファイル名, InStr(ファイル名, ".") - 1)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(貼付行, 1), Address:=ファイル名, TextToDisplay:=ディスプレイ

ファイル名 = Dir() Loop
End Sub

何度もすみません。
よろしくお願い致します。