今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.4ベストアンサー
- 回答日時:
?
https://oshiete.goo.ne.jp/qa/12654911.htmlこちら(#2)で複数メールアドレス取得できていませんか?
どのように(訂正)書き加えれば良いか分からないと言う事ですか?
ついでなので
If f1 = False Then は
If mailTo ="" Then とすれば f1変数、f1 = Trueなどは不要ですね
No.3
- 回答日時:
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 を上記の様にすれば、良いかも知れません。
No.2
- 回答日時:
こんばんは。
例えば、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 のメールアドレスになるかと思いますが、
多分、そのままでも、送信はできるかと思いますので。
No.1
- 回答日時:
こんにちは
同じようなことを何度も質問なさっているようですけれど・・・
ご提示のコードでは、ご質問文にある
>専用があればaquarius0319にフレッツがあれば
>b230420に送るようにしているのですが~
以外の処理も行っているようなので、どこまで修正しても良いのか不明です。
>どうすればよろしいでしょうか?
現状では、ヒットした際に、対応する送り先のみに送るようになっているのを、単純に、キーワードが見つかったら、宛先に追加するようなロジックに変えれば良いだけではないでしょうか?
送り先は「;」区切りで追加すれば良いので、
>mailTo = k(i, 1) ←ここで宛先が一つに固定されている
部分を、「宛先を追加する」ようにすれば良いのですが、先に述べたように、他の検索キーでヒットした場合にどうするのか不明なので、具体的な処理をどうするのかは質問者様にしかわからないでしょう。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/02/22 08:53
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) 【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする 5 2022/03/26 18:31
- Excel(エクセル) EXCEL マクロで行を挿入して貼り付けようとするとエラーになる。 2 2022/05/24 09:43
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
- Excel(エクセル) マクロで列を加えたら上手くいかなくなりました。 2 2022/05/23 17:59
- Visual Basic(VBA) 2つ目のコンボボックスが動作しません。 3 2023/03/25 12:29
- Visual Basic(VBA) 複数のcsvファイルをExcelに一括変換したい 2 2023/03/03 12:44
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
php 完了画面の送信メールのコ...
-
メールフォームのタイトルが文...
-
指定した時間にPHPプログラムを...
-
PHPMailerのコードエラーが解決...
-
PHPからロリポップ!のメールサ...
-
ローカル環境でのメール送信
-
mb_send_mail関数が利用出来ない
-
mail関数を使った場合のReturn-...
-
こちらはただの直列処理ですか?
-
onedrive にexcelファイルをア...
-
フォントの色を変えるには?
-
VBでメールを送る時のSMT...
-
ワードプレスサイト PHP8.0.25...
-
FTPコマンドでディレクトリごと...
-
アップロード画像数でCSSを分け...
-
二重投稿防止方法
-
PHPのif文でその処理を途中で抜...
-
入力フォームの空白や改行を制...
-
php5のrename()は日本語をリネ...
-
sqlで日付が一番古いデータの月...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
php 完了画面の送信メールのコ...
-
さくらサーバーにて、phpからメ...
-
メールフォームのタイトルが文...
-
PHPsendmailにて送信元を変更
-
mb_send_mail関数が利用出来ない
-
PHPからロリポップ!のメールサ...
-
VBA 添付ファイルをつけてメー...
-
mailやmb_send_mail関数で、本...
-
sendmailでエラーがでます
-
PHPでの仮登録時の会員認証メー...
-
phpでメール送信できません 原...
-
mb_send_mail() 第 4、5 引数の...
-
PHPMailerのコードエラーが解決...
-
ローカル環境でのメール送信
-
PHPからメールを送る@さくらイ...
-
PHPでメールを送信するには
-
mb_send_mailについて
-
mail関数を使った場合のReturn-...
-
メールの本文をSmartyにしたい
-
サーバーによってはmb_send_mai...
おすすめ情報
すいません
これをどこと書き換えればよろしいのでしょうか?
素人で申し訳ありません
そうです
どこをどう書き換えればいいのかさっぱりわかりません
助けてください
すいません
どこをどう書き換えればいいのかさっぱりわかりません
助けてください