今wordで専用があればaquarius0319にフレッツがあればsyunsukeにINSがあればb230420に専用とフレッツとINSがあれば全員に送るVBAを作りたいのですがexcel版は出来たもののword版は知識不足で作れませんでした
どこを変更すればよろしいでしょうか?
Option Explicit
Sub goosample()
Const olMailItem = 0
Dim file As String, Bk As Workbook, SH As Worksheet, i As Long, f1 As Boolean
Dim ol As Object, mail As Object, mailTo As String, k(0 To 2, 0 To 2), myRng As Range, o As Integer
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) = "shusnsuke": k(2, 1) = "b230420"
Set Bk = Workbooks.Open(file)
f1 = False
mailTo = ""
For Each SH In Bk.Worksheets
SH.Select
For i = 0 To UBound(k, 1)
Set myRng = SH.UsedRange
If Application.WorksheetFunction.CountIf(myRng, "*" & k(i, 0) & "*") > 0 Then
If f1 Then
mailTo = mailTo & " ;" & k(i, 1)
Else
mailTo = k(i, 1)
f1 = True
End If
End If
Next i
Next SH
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
For o = 1 To .SelectedItems.Count
mail.Attachments.Add .SelectedItems(o)
Next
End If
End With
'メール送信
mail.Send '送信
ol.Quit
End Sub
A 回答 (4件)
- 最新から表示
- 回答順に表示
No.4
- 回答日時:
#3です
ご質問を返しましたので、このまま放置する事は失礼と思い回答をいたします。
個人的な回答ですが、私の回答、サンプルコードは開発者の為のものです。
開発、プログラム作成をしたい方が基本的にご質問をされていると思っています。
~するものを作りたい方に対しての回答です
~するものを使いたい方への回答ではありません。
示したサンプルが、したい事を処理できたとしても そのコードはサンプルであり デバッグを繰り返し検証したものではありません。したがってデバッグや検証、内容については、質問者自身が自己責任で検証し、デバッグする事が必要です。
これらを、開発者は理解しているものと思います
ご質問の処理は、大げさな処理では無いと思いますので
プロの作成会社に依頼されるのが、最も幸せになれる手段と存じます。
時間経費を考えれば、費用をかけて作ってもらっても相当安いと思います。
お力になれず、すみません。
No.3
- 回答日時:
こんにちは
#1,#2には不備不足がありましたので付け加えます。
Set wdApp = CreateObject("Word.Application") となっておりますが、
wordのメソッド、プロパティを操作する為、事前バインディングをしてください。
一部は私が書いたものそのままなので、初めから補足のようなコメントがあれば変わったかもしれませんね。
ご質問の目的を達成する為には、wordを開いてword内をキーで探して
キーに紐づくアドレスでOutlookの送信先アドレスを作り、Outlookのmail.To =に入れるで合っていますでしょうか?(Excelも同じ)
少なくとも、Excelではそのようになっています。
①ファイルを開く
②キーを設定するところ
③wordを開きアドレスを作る
④Outlookを開く
⑤添付ファイルなど各種を設定
ここで、③wordを開きアドレスを作る が解らないと言うご質問と解釈しましたので アドレスを作るサンプルとして記載しました。
>申し訳ありませんがコードを全文書いてもらってもよろしいでしょうか?
現状、そのような気にはなりません。
全文を書いてもらうより、今あるものを理解した方が良いと思います。
全く見当もつかないのでしょうか?
No.2
- 回答日時:
#1補足を忘れました
配列はシート上にマトリックスで書いている事を想定している為、インデックス1から始まる2次配列です。
ご質問コードの様に配列設定する場合は、0からになります。
No.1
- 回答日時:
こんばんは、
ご質問コードを理解しているとして
mailToを設定できれば良いものと思います。
mailToを取得するFunctionを書いてみました。
Wordだけだと解り難いと思いましたので引数分岐でExcelも出来るようにしましたのでご質問コードとExcel用Function、Word用を見比べて試してください。
Functionの引数は(フルパス、第一条件、キーワードとアドレスの配列)
戻り値はメールアドレスです。探す第一条件は空白でも良いですが、古いご質問にあった東京都や秋田でも仕様によって変えてください。
Private Function target_word(file As String, cd1 As String, k) As String
'--sharing
Dim i As Long
Dim mailTo As String: mailTo = ""
'--Word
If InStr(file, ".docx") > 0 Then
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim tmp As String
Set wdApp = CreateObject("Word.Application")
If file <> "" Then Set wdDoc = wdApp.Documents.Open(file) Else Exit Function
wdApp.Visible = True
For i = 1 To UBound(k, 1)
tmp = wdDoc.Content.Text
If InStr(tmp, cd1) > 0 Then
If InStr(tmp, k(i, 1)) > 0 Then
If mailTo <> "" Then
If InStr(mailTo, k(i, 2)) <= 0 Then mailTo = mailTo & " ;" & k(i, 2)
Else
mailTo = k(i, 2)
End If
End If
End If
Next i
target_word = mailTo
wdDoc.Close
wdApp.Visible = False
Set wdApp = Nothing
End If
'--Excel
If InStr(file, ".xls") > 0 Then
Dim Bk As Workbook
Dim SH As Worksheet
If file <> "" Then Set Bk = Workbooks.Open(file) Else Exit Function
For Each SH In Bk.Worksheets
If Not SH.UsedRange.Find(What:=cd1, LookAt:=xlPart) Is Nothing Then
For i = 1 To UBound(k, 1)
If Not SH.UsedRange.Find(What:=k(i, 1), LookAt:=xlPart) Is Nothing Then
If mailTo <> "" Then
If InStr(mailTo, k(i, 2)) <= 0 Then mailTo = mailTo & " ;" & k(i, 2)
Else
mailTo = k(i, 2)
End If
End If
Next
End If
Next
target_word = mailTo
Bk.Close
Set Bk = Nothing
End If
End Function
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) エクセルのマクロについて教えてください。 3 2023/02/22 08:53
- Visual Basic(VBA) ExcelVBAで、index、match関数を使用して、指定範囲に出力したい 3 2022/10/18 21:53
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Excel(エクセル) VBA フォルダ見える化のコードについて 2 2023/06/19 15:04
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
mb_send_mailを実行するとエラ...
-
PHP+MysQLで返信する内容をMy...
-
onedrive にexcelファイルをア...
-
Illustratorで文字と画像を流し...
-
拡張子php画像をjpg画像等に変...
-
one drive のアップロード失敗...
-
URLの変わらないページをPHPで...
-
imgタグでのphpの呼び出しについて
-
URLが.PHPってどういう...
-
データ送信をボタンを押さずに...
-
AccessのDoCmd.SendObjectについて
-
LinuxでのPHP、Configure Comma...
-
PHPにてC言語プログラムを呼び...
-
<img src=~.php>へのデータの...
-
サーバー間のファイルの移動(コ...
-
PHPによる画像の生成による色の...
-
別ファイルの変数を呼び出した...
-
画像処理について
-
cakephpのサブタイトルはどこで...
-
パーミッションの考え方。
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
さくらサーバーにて、phpからメ...
-
mb_send_mail関数が利用出来ない
-
ローカル環境でのメール送信
-
pearのMailライブラリがうまく...
-
メールの本文が取得できない
-
PHPからメールを送る@さくらイ...
-
指定した時間にPHPプログラムを...
-
mail関数を使った場合のReturn-...
-
mb_send_mailでのメール送信が...
-
cronでメールを送信すると文字...
-
mb_send_mailについて
-
ワードプレス 予約システム
-
mb_send_mailでタイトルにハテ...
-
mb_send_mail()が使えない
-
PHPで、一度に大量のメールの送...
-
phpでのメール送信
-
PHP4.4.1でmb_send_mailの送信...
-
PHPでのフォーム送信・・・・
-
コマンドプロンプト、VBSでの添...
-
メールアドレス形式チェックソ...
おすすめ情報
すいません
質問のコードも教えてもらったものなので理解できていません
申し訳ありませんがコードを全文書いてもらってもよろしいでしょうか?
まったく見当もつきません