先生: よっしゃ！今日はこのコードを見ていこうな。これは、特定の送信者からのメールを保存するプログラムやで。
生徒: どんなことをするプログラムなんですか？
先生: これは、指定した送信者から届いたメールを、指定した日付以降で検索して、メールの内容をテキストファイルとして保存するんや。そして、もし添付ファイルがあれば、それも保存するんやで。
生徒: へー！じゃあ、このコードが最初にすることは何ですか？
先生: 最初に、送信者のメールアドレスと保存先のパスを決めてるんや。それから、ユーザーに「メールの受信日以降のデータを取得する日付」を入力させるんや。
生徒: それで、その日付を使ってどうするんですか？
先生: ユーザーが入力した日付をspecifiedDateとして保存して、その日付以降に受け取ったメールを検索するんや。そして、そのメールが特定の送信者からのものかをチェックしてるんや。
生徒: もしそのメールが送信者からのもので、指定した日付以降のメールだったらどうするんですか？
先生: そのメールが条件に合うとき、まずはメールの件名や受信者、送信者、文面をテキストファイルに保存するんや。そして、添付ファイルがあったら、CSVファイルはExcel形式で保存するし、それ以外のファイルはそのまま保存するんや。
生徒: なるほど！そのメールの内容をテキストファイルに保存するんですね。
先生: そうやで。そして、エラーが発生したら、そのエラー内容を別のログファイル（error_log.txt）に保存するようになってるんや。
生徒: メールを検索するのはどうやってやるんですか？
先生: それは、SearchEmails っていうサブルーチンを使ってるんや。このサブルーチンは、指定されたフォルダ内のメールをひとつずつ調べていくんや。もしメールが送信者と合致し、日付が指定した日付以降なら、そのメールを保存するんや。
生徒: それって、サブフォルダの中のメールも調べてくれるんですか？
先生: その通り！サブフォルダ内のメールも調べるために、再帰的にSearchEmailsを呼び出してるんや。これで、どんなフォルダの中のメールでも見逃さずにチェックできるんや。
生徒: すごい！それで、最後にはどうなるんですか？
先生: 最後に、メールの保存が完了したら、「○件のメールを保存しました」ってメッセージが出るんや。また、CSVファイルがあれば、それをExcel形式で保存するための処理もしてるんやで。
生徒: それで、メールの保存作業が終わったってことですね！
先生: そうや！このコードは、特定の送信者のメールを効率よく保存できるようになってるんやで。
Sub 特定の送信者からのメールtxt保存()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim senderEmail As String
Dim savePath As String
Dim count As Integer
Dim specifiedDate As Date
Dim dateInput As String
Dim errorLogFile As String
' 特定の送信者のメールアドレスを設定
senderEmail = "example@example.com" ' ここに送信者のメールアドレスを入力
' 保存先のパスを設定
savePath = "C:\Your\Path\" ' ここに保存先のパスを入力
errorLogFile = savePath & "error_log.txt"
' ユーザーに日付を入力させる
dateInput = InputBox("メールの受信日以降のデータを取得する日付を入力してください (YYYY/MM/DD):", "日付入力")
' 入力された日付をDate型に変換
On Error Resume Next
specifiedDate = CDate(dateInput)
If Err.Number <> 0 Then
MsgBox "正しい日付形式ではありません。"
Exit Sub
End If
On Error GoTo 0
' Outlookアプリケーションを取得
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFolder = olNs.GetDefaultFolder(olFolderInbox) ' 受信トレイを指定
count = 0
' サブフォルダー以下のすべてのメールを検索
SearchEmails olFolder, senderEmail, specifiedDate, count, savePath, errorLogFile
MsgBox count & " 件のメールを保存しました。"
End Sub
Sub SearchEmails(ByVal olFolder As Outlook.MAPIFolder, ByVal senderEmail As String, _
ByVal specifiedDate As Date, ByRef count As Integer, _
ByVal savePath As String, ByVal errorLogFile As String)
Dim olItem As Object
Dim olMail As Outlook.MailItem
Dim fileName As String
Dim fileNum As Integer
Dim att As Attachment
Dim errorFileNum As Integer
' フォルダー内のメールをループ
For Each olItem In olFolder.Items
If TypeOf olItem Is Outlook.MailItem Then
Set olMail = olItem
If olMail.SenderEmailAddress = senderEmail And olMail.ReceivedTime >= specifiedDate Then
On Error Resume Next
count = count + 1
' 件名を短縮してファイル名に使用
fileName = savePath & ShortenFileName(olMail.Subject, 50) & "_" & count & ".txt"
' メールをテキストファイルとして保存
fileNum = FreeFile
Open fileName For Output As #fileNum
Print #fileNum, "件名: " & olMail.Subject
Print #fileNum, "受信者: " & olMail.To
Print #fileNum, "送信者: " & olMail.SenderName
Print #fileNum, "文面: " & olMail.Body
Close #fileNum
' 添付ファイルを処理
For Each att In olMail.Attachments
If LCase(Right(att.FileName, 3)) = "csv" Then
' CSVファイルの場合、Excel形式で保存
SaveAttachmentAsExcel att, savePath
Else
' その他のファイルは通常保存
att.SaveAsFile savePath & att.FileName
End If
Next att
If Err.Number <> 0 Then
' エラーが発生した場合
errorFileNum = FreeFile
Open errorLogFile For Append As #errorFileNum
Print #errorFileNum, "エラー: " & Err.Description & " (メール件名: " & olMail.Subject & ")"
Close errorFileNum
Err.Clear
End If
On Error GoTo 0
End If
End If
Next olItem
' サブフォルダーを再帰的に検索
Dim subFolder As Outlook.MAPIFolder
For Each subFolder In olFolder.Folders
SearchEmails subFolder, senderEmail, specifiedDate, count, savePath, errorLogFile
Next subFolder
End Sub
' CSVファイルをExcelとして保存する関数
Sub SaveAttachmentAsExcel(ByVal att As Attachment, ByVal savePath As String)
Dim tempFilePath As String
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim fileExtension As String
' 添付ファイルを一時的に保存するパス
tempFilePath = savePath & att.FileName
att.SaveAsFile tempFilePath
' Excelアプリケーションを起動
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False ' Excelを非表示にする
' CSVファイルを開く
Set xlWorkbook = xlApp.Workbooks.Open(tempFilePath)
Set xlSheet = xlWorkbook.Sheets(1)
' Excelとして保存する（拡張子を変更）
fileExtension = LCase(Right(att.FileName, 3))
If fileExtension = "csv" Then
xlWorkbook.SaveAs savePath & ShortenFileName(att.FileName, 50) & ".xlsx", 51 ' 51 = xlOpenXMLWorkbook (xlsx)
End If
' 後処理
xlWorkbook.Close False
xlApp.Quit
' 一時ファイルを削除
Kill tempFilePath
End Sub
' ファイル名を短縮する関数
Function ShortenFileName(s As String, maxLength As Integer) As String
If Len(s) > maxLength Then
ShortenFileName = Left(s, maxLength - 3) & "..." ' 最大長を超える場合、短縮
Else
ShortenFileName = s
End If
End Function
