プロが教える店舗&オフィスのセキュリティ対策術

今excelでメールを送るVBAを作っていて
専用があればaquarius0319にフレッツがあればb230420に送るようにしているのですが
専用とフレッツがあれば aquarius0319とb230420両方に送れるようにしたいです
どうすればよろしいでしょうか?
Sub sample()
Const olMailItem = 0
Dim file As String
Dim Bk As Workbook
Dim SH As Worksheet
Dim i As Long
Dim f1 As Boolean
Dim ol As Object
Dim mail As Object
Dim mailTo As String
Dim k(0 To 2, 0 To 2)
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "xls", "*.xls?"
.InitialFileName = "C:\"
.AllowMultiSelect = False
If Not .Show Then Exit Sub
file = .SelectedItems(1)
End With
k(0, 0) = "専用": k(1, 0) = "フレッツ": k(2, 0) = "INS"
k(0, 1) = "aquarius0319": k(1, 1) = "b230420": k(2, 2) = "b230420"
Set Bk = Workbooks.Open(file)
f1 = False
For Each SH In Bk.Worksheets
If Not SH.UsedRange.Find(What:="秋田", LookAt:=xlPart) Is Nothing Then
For i = 0 To UBound(k, 1)
If Not SH.UsedRange.Find(What:=k(i, 0), LookAt:=xlPart) Is Nothing Then
mailTo = k(i, 1)
f1 = True
GoTo HitKey
End If
Next
End If
Next
HitKey:
Bk.Close
If f1 = False Then
MsgBox "無かった"
Exit Sub
Else
MsgBox "見つけた"
End If
Set ol = CreateObject("Outlook.Application")
Set mail = ol.CreateItem(olMailItem)
mail.Display
mail.To = mailTo '宛先
mail.Subject = "件名"
mail.Body = "本文"
'添付ファイル
mail.Attachments.Add file
'添付ファイル
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "添付ファイル", "*.*"
.InitialFileName = "C:\"
.AllowMultiSelect = True
If .Show Then
Dim o As Integer
For o = 1 To .SelectedItems.Count
mail.Attachments.Add .SelectedItems(o)
Next
End If
End With
'メール送信
mail.Send '送信
ol.Quit
End Sub

質問者からの補足コメント

  • すいません
    これをどこと書き換えればよろしいのでしょうか?
    素人で申し訳ありません

    No.2の回答に寄せられた補足コメントです。 補足日時:2021/11/03 18:14
  • つらい・・・

    そうです
    どこをどう書き換えればいいのかさっぱりわかりません
    助けてください

    No.4の回答に寄せられた補足コメントです。 補足日時:2021/11/04 05:46
  • つらい・・・

    すいません
    どこをどう書き換えればいいのかさっぱりわかりません
    助けてください

    No.3の回答に寄せられた補足コメントです。 補足日時:2021/11/04 05:48

A 回答 (4件)

? 

https://oshiete.goo.ne.jp/qa/12654911.html
こちら(#2)で複数メールアドレス取得できていませんか?
どのように(訂正)書き加えれば良いか分からないと言う事ですか?

ついでなので 
If f1 = False Then は
If mailTo ="" Then とすれば f1変数、f1 = Trueなどは不要ですね
この回答への補足あり
    • good
    • 0

No.2の者です。



>専用があればaquarius0319にフレッツがあればb230420に送るようにしているのですが
専用とフレッツがあれば aquarius0319とb230420両方に送れるようにしたいです

ここの部分を、試しに作ってみたのですが。

説明不足なので、No.1の方も、どこまで修正して良いか分からないかと。

秋田って、何でしょうか?
秋田がないと、何も処理しないという事なのでしょうか?

何となくですが、今のプログラムは、
Cドライブで、xls、又は、xlsxのファイルを表示させ、選択後に開く。
k(○, ○) に変数を定義している。
全てのワークシートで、秋田を探して、見付かったのなら、
専用、フレッツ、INSを検索し、見付かったのなら、それに対応した
メールアドレスを入れるでしょうか?複数見つかった時は、最後のもの
だけが有効という感じでしょうかね。

質問者さんのプログラムでしたら、下記の様に修正してどうでしょうか?

f1 = False
mailTo = ”” ’ <***** 追加
For Each SH In Bk.Worksheets
If Not SH.UsedRange.Find(What:="秋田", LookAt:=xlPart) Is Nothing Then
For i = 0 To UBound(k, 1)
If Not SH.UsedRange.Find(What:=k(i, 0), LookAt:=xlPart) Is Nothing Then
mailTo = mailTo & " ; " & k(i, 1) ’ <***** 変更
f1 = True


f1 = False から、f1 = True を上記の様にすれば、良いかも知れません。
この回答への補足あり
    • good
    • 0

こんばんは。



例えば、Excelの関数のCountIfで、使用セルに専用などがあるか?を判定。
それをフラグに入れておいて、最後にまとめて判定する様な感じですが。
手入力なので、間違えがあるかも知れませんので、適宜修正して下さい。

Dim myRng as Range , myFlag(1 to 2) As Boolean

For Each SH In Bk.Worksheets
Set myRng = SH.UsedRange
if WorksheetFunction.CountIf(myRng, "専用") > 0 then myFlag(1)=True
if WorksheetFunction.CountIf(myRng, "フレッツ") > 0 then myFlag(2)=True
Next SH

mailTo=""
if myFlag(1) Then mailTo="aquarius0319"
if myFlag(2) Then mailTo=mailTo & " ; b230420"

上記の様な書き方では、どうでしょうか?
フレッツだけの時に ; b230420 のメールアドレスになるかと思いますが、
多分、そのままでも、送信はできるかと思いますので。
この回答への補足あり
    • good
    • 0

こんにちは



同じようなことを何度も質問なさっているようですけれど・・・

ご提示のコードでは、ご質問文にある
>専用があればaquarius0319にフレッツがあれば
>b230420に送るようにしているのですが~
以外の処理も行っているようなので、どこまで修正しても良いのか不明です。

>どうすればよろしいでしょうか?
現状では、ヒットした際に、対応する送り先のみに送るようになっているのを、単純に、キーワードが見つかったら、宛先に追加するようなロジックに変えれば良いだけではないでしょうか?
送り先は「;」区切りで追加すれば良いので、
>mailTo = k(i, 1)  ←ここで宛先が一つに固定されている
部分を、「宛先を追加する」ようにすれば良いのですが、先に述べたように、他の検索キーでヒットした場合にどうするのか不明なので、具体的な処理をどうするのかは質問者様にしかわからないでしょう。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!