エラー原因がわかりません。

最近の書き込み件数：今日 0件、昨日 0件
未読分：1件

Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応

近田伸矢, 植木悠二, 上田寛

IEのデータ収集＆自動操作のプログラミング本はこの1冊だけ！IEの起動やポップアップウィンドウ、表示を制御する基本的なコードはもちろん、テキストボックスやラジオボタン、表、ハイパーリンクなどのHTML部品を制御する方法など、自動操作に欠かせないノウハウを丁寧に解説。

Message#1 2022年4月20日(水)14時53分
From: raiden

返事削除変更

VBAメール送信コードを参考にしながら書いたのですが、”アプリケーション定義またはオブジェクト定義のエラー”がでました。
コードを見ながら原因を探しているのですが、見つかりません。上級者の方原因がわかるお方見ていただけますか？
コードは
Option Explicit
Private Sub sendmailsample1()

Dim temprange As Range

Dim dataarray() As Variant

Dim listsh As Worksheet

Set listsh = ThisWorkbook.Worksheets("メール送信")

'データ範囲をはいれるに取得する
With listsh

Set temprange = .Range("a1").CurrentRegion

With temprange

Set temprange = .Resize(.Rows.Count - 1).Offset(1)

End With

dataarray = temprange.Value

End With

'outlookの定数。参照設定には不要

Const olmailitem As Long = 0

Dim olapp As Object

Dim olmailmessage As Object

Dim tempbody As String

Dim i As Long

'outlookのインスタンスを作成

Set olapp = CreateObject("Outlook.Application")

On Error GoTo errhdl

Dim msgbody As String

For i = 1 To UBound(dataarray)

'メッセージを新規作成

Set olmailmessage = olapp.createitem(olmailitem)
'メッセージの内容を設定して送信メール作成

msgbody = vbNullString

With olmailmessage

'「to」を指定

.To = dataarray(i, 2)

'「件名」を指定
.Subject = listsh.Range("f2").Value

'本文を「会社名」と「担当者名」「本文」から作成

tempbody = dataarray(i, 3) & vbCrLf & dataarray(i, 4) & _
vbCrLf & listsh.Range("g2").Value

'「添付ファイル」を指定

If listsh.Range("h2").Value <> "" Then

.attachments.Add ThisWorkbook.Path & listsh.Range("h2").Value

End If

'本文を指定

.htmlbody = msgbody & .htmlbody

End With

Next

exithdl:

Set olmailmessage = Nothing

Set olapp = Nothing

Exit Sub

errhdl:

MsgBox Err.Description, vbExclamation

Resume exithdl

End Sub

シートはシート１メール送信です。
シート内容は
A1　「No」
B1 「To」
c1 「会社名」
D1　「担当者」
E1 「なし」
F1 「件名」
を作成しております。
原因のお分かりになる方ご教示お願い致します。