ExcelのVBAなんですがエクセルに専用と書いていても"無かった"と表示されてしまします
なぜでしょうか?
Sub 最終sample()
Const olMailItem = 0
Dim file As String
Dim pr As Workbook
Dim sl As Worksheet
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
Dim mailTo As String
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "xlsx", "*.xlsx?"
.InitialFileName = "C:\"
.AllowMultiSelect = False
If Not .Show Then Exit Sub
file = .SelectedItems(1)
End With
Do
Set pr = Workbooks.Open(file)
For Each sl In pr.Worksheets
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
mailTo = "aquarius0319"
End If
If InStr(s, "フレッツ") Then
f1 = True
mailTo = "b230420"
End If
If InStr(s, "INS") Then
f1 = True
mailTo = "b230420"
End If
If f1 Then Exit Do
Next
Next
End If
Next
Next
MsgBox "無かった"
Loop Until True
pr.Close
If Not (f1) Then Exit Sub
'
MsgBox "見つけた"
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ベストアンサー
- 回答日時:
>2つキーワードがあった時は2か所のアドレスを作るのでしょうか?
#1 k(2, 2) = "b230420"ミスがあったので 下記に書き替えたサンプルを出します。
配列作成以下対象ブックを開いて閉じるところのサンプルです。
ちなみにOUTLOOKメールアドレスをつなげるのは、 半角スペース+セミコロンだったかと記憶していますが、違うかもです。
k(0, 0) = "専用": k(1, 0) = "フレッツ": k(2, 0) = "INS"
k(0, 1) = "aquarius0319": k(1, 1) = "b230420": k(2, 1) = "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
If mailTo <> "" Then
mailTo = mailTo & " ;" & k(i, 1)
Else
mailTo = k(i, 1)
f1 = True
End If
End If
Next
End If
Next
Bk.Close
ちなみに改修しやすくするアドバイスとして
名簿データシートを作成して その列にIDやキーワード、メルアドなどを
表にします。行方向はIDに対して関連項目になります。
VBAで配列を作る時や多くのキーワードを探す場合など表の範囲を指定すれば値を取得できます。
各項目が変更になる場合などそのシートを変更すれば、VBAコードを書き直す必要が減りますね。
シートは、通常表示できないようにVBAで非表示にすれば良いです。
No.1
- 回答日時:
こんにちは
コードを見るとシェイプが出てきておりますが、Excelはセルの値で良いのでしょうか?
IFで"専用"などを探しているようですが、
キーワードが2つあった場合は、どのような優先順位をお考えですか?
2つキーワードがあった時は2か所のアドレスを作るのでしょうか?
https://oshiete.goo.ne.jp/qa/12646659.htmlへのレスもないですが、
サンプルを示せを示せば、ご自身で改修出来ますか?
変な条件設定なので書き直しますね。
秋田がある事と"専用""フレッツ""INS"いづれかがある事でメールを作成します。
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) エクセル マクロ(A1:A10)までの中で一番多く出た数字をB10に表示 6 2023/04/25 17:01
- その他(Microsoft Office) マクロVBAについて 1 2022/09/06 18:12
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ローカル環境でのメール送信
-
mail関数に送信について
-
PHPで、一度に大量のメールの送...
-
さくらサーバーにて、phpからメ...
-
mb_send_mail でスパム扱いとなる
-
コマンドプロンプト、VBSでの添...
-
PHP4.4.1でmb_send_mailの送信...
-
メールフォームのタイトルが文...
-
Parse errorの対処法について
-
フォントの色を変えるには?
-
onedrive にexcelファイルをア...
-
PHPで新しいウインドウで開く命...
-
別ファイルの変数を呼び出した...
-
バッチを用いたフォルダの自動移動
-
php.ini を設定を変更すると再...
-
form actionで二つ送信先を指定...
-
phpの中でphpを書けないか
-
「@$変数」の「@の意味は?」
-
リダイレクトでPOST
-
PHPで、エラーがない場合のみ画...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
php 完了画面の送信メールのコ...
-
さくらサーバーにて、phpからメ...
-
メールフォームのタイトルが文...
-
ローカル環境でのメール送信
-
mb_send_mail関数が利用出来ない
-
PHPsendmailにて送信元を変更
-
mail関数を使った場合のReturn-...
-
複数行の文字列をメールのヘッ...
-
phpでのメール転送(添付ファイ...
-
PHPで、複数のアドレスにメール...
-
000webhost.comでphpのmail()
-
サーバーによってはmb_send_mai...
-
【初歩?】変数をセットできな...
-
phpでメール送信できません 原...
-
PHPMailerのコードエラーが解決...
-
POP Before SMTPでメールを送信...
-
コマンドプロンプト、VBSでの添...
-
PHPからロリポップ!のメールサ...
-
mailやmb_send_mail関数で、本...
-
phpでのメール送信
おすすめ情報
コードを見るとシェイプが出てきておりますが、Excelはセルの値で良いのでしょうか?
回答 そうです
IFで"専用"などを探しているようですが、
キーワードが2つあった場合は、どのような優先順位をお考えですか?
2つキーワードがあった時は2か所のアドレスを作るのでしょうか?
回答 2つのキーワードがあったら2箇所におくります
すいません
自分では変えれなそうです‥