質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

1回答

1002閲覧

複数のメールを一括作成するマクロを組んだのですが、パスの取得を可変にしたところ、ループが回らなくなりました。

oftn

総合スコア19

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2020/05/21 08:28

編集2020/05/21 09:44

表記の通りです。
まずメールを一括作成するマクロを組み、そこまでは目的の動作を果たしてくれました。
そこで、最後のフォルダ名が異なるだけのほとんど一緒のフォルダ構成のフォルダのいくつかで、同様の動作を行いたいため、ファイルを取得するパスを可変にするため、
ボタンを作成し、ボタンの変数をmain()に渡すようにしました。
ボタンで渡す変数名はfNameとし、
フォルダ構成の「初日時点」「中日時点」「最終通知」をボタンによって渡しています。
(※当初はフォルダ名と同様「1日時点」「15日時点」だったのですが、先頭数字は渡せないと知り、
ボタン名とフォルダ名を上記のものに変更したため、
画像はすこし古いものです。)

ボタンの作成には成功し、変数を渡せるようになったのですが、
メールは1通目しか作られません。
デバッグしてみると、
対象フォルダにファイルがあれば、ファイルの数だけ繰り替えすループが、2通目以降は飛ばされてしまっているようです。
どなたか解決のお力を貸していただけないでしょうか。

VBA

1' 処理① キーワードに合致するファイルを添付する 2' 処理② 1つ以上のファイルが見つかった場合、Trueを返す 3Function FileAttach(attachObj As Object, FileStorePath As String) As Boolean 4 5 Dim fileCnt As Long '★添付したファイル数をカウントする 6 7 Dim FileName As String 8 FileName = Dir(FileStorePath & "\" & "*") 9  ' MsgBox FileStorePath 10 11 **'フォルダ内のファイル数、検索を繰り返す&"** 12 **'↓Do While にかかると、2通目以降は飛ばされてしまう部分"** 13 Do While FileName <> "" 14 attachObj.Add FileStorePath & "\" & FileName 15 fileCnt = fileCnt + 1 '★添付したファイル数 16 FileName = Dir() 17 18 Loop 19 20 Set attachObj = Nothing 21 22 '★1以上のファイルを添付した場合Trueを返す 23 '(Boolean型の初期値はFalse) 24 If fileCnt > 0 Then FileAttach = True 25 26End Function 27 28

VBA

1 2Enum Col '1以降の数値を省略した場合は+1される 3 宛先 = 1 4 複写 5 クラス名 6 クラス代表者氏名 7 添付キーワード 8 先生氏名 9End Enum 10 11Sub main(fName as String) 12 'Dim Col As Cols 13 Dim r As Long 14 'Outlookオブジェクトの作成 15 Dim OutlookObj As Outlook.Application 16 Set OutlookObj = New Outlook.Application 17 18 For r = 2 To Cells(1, 1).End(xlDown).Row 19 20 'メールアイテムオブジェクト作成 21 Dim mailItemObj As Outlook.MailItem 22 Set mailItemObj = OutlookObj.CreateItem(olMailItem) 23 24 '添付ファイルオブジェクトの生成 25 Dim attachObj As Outlook.Attachments 26 Set attachObj = mailItemObj.Attachments 27 28 Dim cName As String, sName As String, tName As String 29 cName = Cells(r, Col.クラス名).Value 30 tName = Cells(r, Col.先生氏名).Value 31 32 Dim FileStorePath As String 33 FileStorePath = "C:\Outlookテスト\" & tName & "先生\" & cName & "\" & fName 34 35 '★添付ファイルが存在する場合のみ、メールアイテムを作成する 36 If FileAttach(attachObj, FileStorePath) = True Then 37 38 'メール本文作成 39 Dim mailBody As String 40 mailBody = CreateMailBody(r) 41 42 'メールアイテム作成 43 With mailItemObj 44 .To = Cells(r, Col.宛先).Value 45 .CC = Cells(r, Col.複写).Value 46 .Subject = Cells(1, "I").Value '件名 47 .Body = mailBody '本文 48 End With 49 50 mailItemObj.Display '下書きを表示 51 52 '次のメールアイテムを作成するためいったん破棄 53 Set mailItemObj = Nothing 54 55 End If 56 57 Next r 58 59End Sub 60

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ttyp03

2020/05/21 09:04

Dirのループが回らない原因はDirに渡しているパスが正しくないときのみです。 FileAttachに渡されるFileStorePathが正しいことは確認できていますか?
oftn

2020/05/21 09:53

ひとつめのVBAの5行目に、MsgBox FileStorePathをつけて確認しましたが、FileStorePathは正しく表示されます。「OK」を押下すると、次のパスがループで表示されます。 そのため、1通目のメールも作れているのだと認識しています。
tosi

2020/05/22 05:46

FileName = Dir(FileStorePath & "\" & "*") MsgBox FileStorePath ここで確認するのはFileNameの方が良いです。 (FileStorePathの確認はモジュールの先頭部分) MsgBox FileNameで文字列取れていますか? 無い場合はフォルダ名とその存在を確認します。 目視で絶対に大丈夫であれば、フォルダ存在確認処理をモジュール先頭部へ入れる必要が出てくるかと思われます。
guest

回答1

0

ベストアンサー

フォルダーとファイルチェックしてみてください。

vb

1Enum Col '1以降の数値を省略した場合は+1される 2 宛先 = 1 3 複写 4 クラス名 5 クラス代表者氏名 6 添付キーワード 7 先生氏名 8End Enum 9 10Sub tes(fName As String) 11 12 Dim r As Long 13 Dim cName As String, sName As String, tName As String 14 Dim FileStorePath As String 15 Dim FileNameS As String 16 Dim FileName As String 17 18 For r = 2 To Cells(1, 3).End(xlDown).Row 19 20 cName = Cells(r, Col.クラス名).Value 21 tName = Cells(r, Col.先生氏名).Value 22 23 FileStorePath = "C:\Outlookテスト\" & tName & "先生\" & cName & "\" & fName 24 25 FileName = Dir(FileStorePath, vbDirectory) 26 If FileName = "" Then 27 FileNameS = "フォルダー見つかりません。" & FileStorePath 28 Else 29 FileNameS = "対象フォルダー" & FileStorePath & vbCrLf 30 FileName = Dir(FileStorePath & "\" & "*") 31 Do While FileName <> "" 32 FileNameS = FileNameS & FileName & vbCrLf 33 FileName = Dir() 34 Loop 35 End If 36 MsgBox FileNameS 37 Next r 38 39End Sub 40

投稿2020/05/21 11:41

sinzou

総合スコア392

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

oftn

2020/05/30 04:58

上記のテストをしたところ、値が取れていない箇所がわかりました。ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問