型が一致しないエラーについて

Question

今ワードに反応してメールを送るvbaを作成しています
そこでf1がtureならoutlookを起動させたいのですが型が一致しませんとエラーが出ます
なぜでしょうか？
エラーが出るのは

If CreateObject("Outlook.Application") Then です

Sub sample()
Const olMailItem = 0
Dim file As String
Dim pr As Presentation
Dim sl As Slide
Dim sh As Shape
Dim tb As Table
Dim r As Integer
Dim c As Integer
Dim s As String
Dim f1 As Boolean
Dim f2 As Boolean
Dim ol As Object
Dim mail As Object
Dim f As Object
Dim dic As Object
Dim k As Variant
Dim n As Variant

With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "ppt", ".ppt?"
.InitialFileName = "C:"
.AllowMultiSelect = False
If Not .Show Then Exit Sub
file = .SelectedItems(1)
End With
Do
Set pr = Presentations.Open(file)
For Each sl In pr.Slides
f1 = False
f2 = False
For Each sh In sl.Shapes
If sh.HasTable Then
Set tb = sh.Table
For r = 1 To tb.Rows.Count
For c = 1 To tb.Rows(r).Cells.Count
s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
If InStr(s, "フレッツ") Then f1 = True
If InStr(s, "専用") Then f1 = True
If InStr(s, "秋田") Then
If r <> tb.Rows.Count Then
If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
End If
End If
If f1 And f2 Then Exit Do
Next
Next
End If
Next
Next
MsgBox "無かった"
Loop Until True
pr.Close
If Not (f1 And f2) Then Exit Sub
'
MsgBox "見つけた"
'添付ファイル
Set dic = CreateObject("Scripting.Dictionary")
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "添付ファイル", "."
.InitialFileName = "C:"
.AllowMultiSelect = True
If Not .Show Then Exit Sub
file = .SelectedItems(1)
Set dic = CreateObject("Scripting.Dictionary")
Dim i As Integer
For i = 1 To .SelectedItems.Count
dic.Add .SelectedItems(i), Null
Next
End With
'メール送信
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "ppt", ".ppt?"
.InitialFileName = "C:"
.AllowMultiSelect = False
If Not .Show Then Exit Sub
file = .SelectedItems(1)
End With
Do
Set pr = Presentations.Open(file)
For Each sl In pr.Slides
f1 = False
f2 = False
For Each sh In sl.Shapes
If sh.HasTable Then
Set tb = sh.Table
For r = 1 To tb.Rows.Count
For c = 1 To tb.Rows(r).Cells.Count
s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
If InStr(s, "専用") Then f1 = True
If InStr(s, "秋田") Then
If r <> tb.Rows.Count Then
If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
End If
End If
If f1 And f2 Then Exit Do
Next
Next
End If
Next
Next
Loop Until True
If CreateObject("Outlook.Application") Then f1 = True
If mail = ol.CreateItem(olMailItem) Then f1 = True
mail.Display
mail.To = "aquarius0319" '宛先
mail.Subject = "件名"
mail.Body = "本文"
For Each k In dic.keys
mail.Attachments.Add k
Next
Set dic = CreateObject("Scripting.Dictionary")
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "添付ファイル", "."
.InitialFileName = "C:"
.AllowMultiSelect = True
If Not .Show Then Exit Sub
file = .SelectedItems(1)
Set dic = CreateObject("Scripting.Dictionary")
Dim l As Integer
For l = 1 To .SelectedItems.Count
dic.Add .SelectedItems(l), Null
Next
End With
mail.Attachments.Add file
Do
Set pr = Presentations.Open(file)
For Each sl In pr.Slides
f1 = False
f2 = False
For Each sh In sl.Shapes
If sh.HasTable Then
Set tb = sh.Table
For r = 1 To tb.Rows.Count
For c = 1 To tb.Rows(r).Cells.Count
s = tb.Rows(r).Cells(c).Shape.TextFrame2.TextRange.Text
If InStr(s, "フレッツ") Then f1 = True
If InStr(s, "秋田") Then
If r <> tb.Rows.Count Then
If IsNumeric(tb.Rows(r + 1).Cells(c).Shape.TextFrame2.TextRange.Text) Then f2 = True
End If
End If
Next
Next
End If
Next
Next
Loop Until True
Set ol = CreateObject("Outlook.Application")
Set mail = ol.CreateItem(olMailItem)
mail.Display
mail.To = "b230420" '宛先
mail.Subject = "件名"
mail.Body = "本文"
For Each n In dic.keys
mail.Attachments.Add n
'ファイルを添付
Next
Set dic = CreateObject("Scripting.Dictionary")
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "添付ファイル", "."
.InitialFileName = "C:"
.AllowMultiSelect = True
If Not .Show Then Exit Sub
file = .SelectedItems(1)
Set dic = CreateObject("Scripting.Dictionary")
Dim o As Integer
For o = 1 To .SelectedItems.Count
dic.Add .SelectedItems(o), Null
Next
End With
mail.Attachments.Add file
mail.Send '送信
ol.Quit
End Sub

Comments

[hatena19]

コードが途中からのようですね。変数の宣言部分も含めてプロシージャ全体を提示してください。
また、どのコードでエラーがでるのかも提示してください。

[sazi]

コピペ元のコードが理解出来てからコピペするようにした方が良いですよ。

Answer 1

エラーが出るのは

If CreateObject("Outlook.Application") Then です

If CreateObject("Outlook.Application") Then f1 = True
If mail = ol.CreateItem(olMailItem) Then f1 = True

上記を下記に変更してください。

If f1 = True Then
    Set ol = CreateObject("Outlook.Application") Then 
    Set mail = ol.CreateItem(olMailItem)
Else
   Exit Sub
End

これでこの部分でのエラーはなくなるはずです。

---

f1がtureならoutlookを起動させたいのです

この日本語を英訳すると、

If f1 is true, I want to start outlook.

ですよね。そこから考えればどのようなコードにすべきか分かりますよね。

Comments

[shunsuke_0319]

すいません
わからないです

[hatena19]

頑張って勉強してください。

[shunsuke_0319]

すいません
教えて貰ってもいいですか？

Answer 2

CreateObject("Outlook.Application")の値はString型なので、ifの条件部分には書けません。
If "A" Thenがエラーになるのと同じ。

何を判断したいのでしょうか？

Comments

[shunsuke_0319]

専用で秋田ならaquarius0319にメールを送れるようにする判断です

[otn]

CreateObject("Outlook.Application")
の結果をどう扱っても、そういう判断は出来ません。

[shunsuke_0319]

ならどうすればよろしいでしょうか？

[otn]

あなたが何をしたいのかわからないと、どうしたらいいかのアドバイスが出来ません。
ですから、
> If CreateObject("Outlook.Application") Then
で、何を判断したいのかを聞いたのですが。
何かを判断したいので、ifを書いたのですよね？

[hatena19]

細かいことですが、
CreateObject("Outlook.Application") の値はObject型ですね。

[shunsuke_0319]

専用で秋田なら
outlookを起動させてメールを送れるようにしたくてifを書きました

[otn]

> Object型ですね。
vartypeが8だったので、数式の文脈ではString扱いなのかと思ったのですが、やはりObjectなんですかね。

[otn]

> 専用で秋田なら
> outlookを起動させてメールを送れるようにしたくてifを書きました

もしかして、
「もし f1 が True なら CreateObject("Outlook.Application")を呼び出す」
ということをしたかったんですかね？

であれば、まず、VBAをゼロから学び直しましょう。

Answer 3

＞ If CreateObject("Outlook.Application") Then f1 = True

素人レベルですが Then の左右が逆とか？
CreateObject("Outlook.Application") は呼び出すのであってIf文の条件式にはならないと感じます。

Comments

[shunsuke_0319]

返信ありがとうございます
thenの左右が逆とはどう言うことでしょうか？
またcreateobjectは条件で呼び出せないのでしょうか