vba 添付ファイルをつけてメールを送る方法について

Question

vbaでワードに反応してメールを送るvbaを作ったのです
添付ファイルをつけれるようにしたいですが
下記にこれを追加したらできるでしょうか
すでに選択したファイルと同じファイルをおくります
mail.Attachments.Add file

Sub ファイル自由参照()
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
With Application.FileDialog(msoFileDialogOpen)
.Filters.Add "ppt", "*.ppt?"
.InitialFileName = "ファイル名"
.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
MsgBox "無かった"
Loop Until True
pr.Close
If Not (f1 And f2) Then Exit Sub
MsgBox "見つけた" 'メール送信
Set ol = CreateObject("Outlook.Application")
Set mail = ol.CreateItem(olMailItem)
mail.Display
mail.To = "メアド" '宛先
mail.Subject = "件名"
mail.Body = "本文"
mail.Send '送信
ol.Quit
End Sub

Comments

[hex309]

ヒントは差し上げましたので、ご自分で試してみて、エラーが出るなどしたら、その部分を提示いただくとよろしいかと

Answer 1

選択したファイルは変数fileに格納しているので、それを添付するのであれば、

fname = Application.GetOpenFilename(フォルダ名")

は不要だと思います。

また、ファイルを添付する箇所ですが、Addメソッドの引数を指定するので「=」ではなく、以下のようになるかと。

mail.Attachments.Add file