OutlookVBA

添付ファイルをパスワードのいずれかで開く。

param (
    [string]$filePath
)

# Excelオブジェクトを作成
$excel = New-Object -ComObject Excel.Application

# パスワードリスト
$passwords = @("", "password_a", "password_b")

# エラーが発生しないようにする
$ErrorActionPreference = "SilentlyContinue"

foreach ($password in $passwords) {
    # エラーフラグを初期化
    $errorFlag = $false
    
    # Excelファイルを開く
    $workbook = $excel.Workbooks.Open($filePath, $null, $true, $null, $password)
    
    # エラーが発生した場合、エラーフラグを設定
    if (-not $workbook) {
        $errorFlag = $true
    }
    
    # エラーフラグが設定されていない場合、ループを抜ける
    if (-not $errorFlag) {
        break
    }
}

# エラーフラグが設定されている場合、エラーメッセージを表示
if ($errorFlag) {
    Write-Host "正しいパスワードが見つかりませんでした。"
}

# Excelを表示
$excel.Visible = $true

# Excelオブジェクトを解放
$excel.Quit()
[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excel) | Out-Null

表示しているメールから情報を取得

Sub ExtractEmailInfoFromCurrentMail()
    Dim olMail As Outlook.MailItem
    Dim emailInfo() As Variant
    
    ' 現在表示しているメールを取得
    Set olMail = Outlook.Application.ActiveInspector.CurrentItem
    
    ' メールが取得された場合
    If Not olMail Is Nothing Then
        ReDim emailInfo(1 To 1, 1 To 3)
        
        ' メールの情報を配列に格納
        emailInfo(1, 1) = olMail.SenderEmailAddress
        emailInfo(1, 2) = olMail.Subject
        emailInfo(1, 3) = olMail.ReceivedTime
        
        ' 配列の情報を表示（例としてメッセージボックスに表示）
        MsgBox "Sender: " & emailInfo(1, 1) & vbCrLf & _
               "Subject: " & emailInfo(1, 2) & vbCrLf & _
               "Received Time: " & emailInfo(1, 3)
    Else
        MsgBox "No email is currently being displayed."
    End If
End Sub

各スレッドのルートメールの一覧を表示

ユーザーフォーム上にカレンダーコントロールを追加します。これには、コントロールツールボックスから「Microsoft MonthView Control」を選択してユーザーフォームにドラッグアンドドロップします。
ユーザーフォームに「OK」ボタンと「キャンセル」ボタンを追加します。

' ユーザーフォームのコード
Private selectedDate As Date

Private Sub UserForm_Initialize()
    ' フォームが初期化されたときにカレンダーコントロールに現在の日付を表示
    Me.MonthView1.Value = Date
End Sub

Private Sub OKButton_Click()
    ' OK ボタンがクリックされたとき、選択された日付を取得しフォームを非表示にする
    selectedDate = Me.MonthView1.Value
    Unload Me
End Sub

Private Sub CancelButton_Click()
    ' キャンセル ボタンがクリックされたとき、選択された日付を空にしてフォームを非表示にする
    selectedDate = Empty
    Unload Me
End Sub

Public Function GetSelectedDate() As Date
    ' 選択された日付を返す関数
    GetSelectedDate = selectedDate
End Function

標準モジュール

Option Explicit
Sub OldestMailOnTop()
    Application.ScreenUpdating = False
    Dim olFolder As Outlook.Folder
    Dim olThreads As Outlook.Conversations
    Dim olThread As Outlook.Conversation
    Dim olRootItems As Outlook.Items
    Dim olItem As Object
    Dim selectedDate As Date
    Dim olFilteredRootItems As Outlook.Items
    
    ' カレンダーフォームを表示して日付を選択
    UserForm1.Show
    
    ' 選択された日付を取得
    selectedDate = UserForm1.GetSelectedDate
    
    ' 選択された日付が空でない場合、処理を続行
    If selectedDate <> Empty Then
        ' アクティブなOutlookフォルダを取得
        Set olFolder = Application.ActiveExplorer.CurrentFolder
        
        ' アクティブなフォルダ内のすべてのスレッドを取得
        Set olThreads = olFolder.GetConversation
        
        ' すべてのスレッドをループで処理
        For Each olThread In olThreads
            ' スレッド内のルートアイテム（最初のメール）を取得
            Set olRootItems = olThread.GetRootItems
            
            ' ルートアイテムの受信年月日でフィルタリング
            Set olFilteredRootItems = olRootItems.Restrict("[ReceivedTime] >= '" & Format(selectedDate, "yyyy-mm-dd") & "'")
            
            ' 最も古いメールが一番上にくるように、メールを日付で昇順にソート
            olFilteredRootItems.Sort "[ReceivedTime]", False
            
            ' 最も古いメールを一番上に表示
            For Each olItem In olFilteredRootItems
                olItem.Display
                Exit For ' 一つ目のメールを表示した後、ループを終了
            Next olItem
        Next olThread
    Else
        ' 選択された日付が空の場合、何もせずに終了
        Exit Sub
    End If
End Sub

選択のフォルダを個別表示にする

Option Explicit
Sub AlwaysIndividualDisplay()
    Application.ScreenUpdating = False
    ' 選択されたフォルダを確認
    If TypeName(Application.ActiveExplorer.CurrentFolder) <> "MAPIFolder" Then
        MsgBox "フォルダが選択されていません。", vbExclamation
        Exit Sub
    End If
    
    ' 選択されたフォルダの個別表示に設定
    Application.ActiveExplorer.CurrentFolder.CurrentView = "IPM.Note"
End Sub

受領連絡を全て行っているかの確認用メッセージボックス

Option Explicit
Sub DisplayRootMailInfo()
    Application.ScreenUpdating = False
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.Items
    Dim olItem As Outlook.MailItem
    Dim olThread As Outlook.Conversation
    Dim olRoot As Outlook.MailItem
    Dim strSenderList As String
    Dim strRootSubject As String
    Dim dtReceived As Date
    Dim strMessage As String

    ' カレンダーフォームを表示して日付を選択
    UserForm1.Show
    
    ' 選択された日付を取得
    selectedDate = UserForm1.GetSelectedDate
    
    If selectedDate = Empty Then
        Exit Sub
    End If
    
    ' Initialize message string
    strMessage = ""
    
    ' Get the selected folder in Outlook
    Set olFolder = Application.ActiveExplorer.CurrentFolder
    
    ' Filter out only mail items
    Set olItems = olFolder.Items.Restrict("[MessageClass]='IPM.Note'")
    
    ' Loop through each thread in the folder
    For Each olThread In olItems.GetConversation
        ' Get the root mail of the thread
        Set olRoot = olThread.GetRootItems(1)
        
        ' Check if the root mail meets the criteria to be displayed
        If Not (olRoot.SenderEmailAddress Like "*helpdesk*" And Left(olRoot.Subject, 3) = "FW:") And olRoot.ReceivedTime >= Format(selectedDate, "yyyy-mm-dd") & "'") Then
            ' Get sender list
            strSenderList = ""
            For Each olItem In olThread.GetRootItems(1).GetTable.Columns("Sender").Items
                strSenderList = strSenderList & olItem & ", "
            Next olItem
            
            ' Get root mail's subject and received date
            strRootSubject = olRoot.Subject
            dtReceived = olRoot.ReceivedTime
            
            ' Add information to message string
            strMessage = strMessage & "Root Mail Subject: " & strRootSubject & vbCrLf & _
                         "Received Date and Time: " & Format(dtReceived, "yyyy-mm-dd hh:mm:ss") & vbCrLf & _
                         "Senders: " & Left(strSenderList, Len(strSenderList) - 2) & vbCrLf & vbCrLf
        End If
    Next olThread
    
    ' Display information in a message box
    If Len(strMessage) > 0 Then
        MsgBox strMessage, vbInformation, "Root Mail Information"
    Else
        MsgBox "No root mails found meeting the criteria.", vbInformation, "Root Mail Information"
    End If
End Sub

特定のフォルダに作成メールを保存する。

Sub ShowSaveDialogWithInitialPath()
​​    Dim fileDialog As FileDialog
​​    Dim selectedFilePath As String
​​
​​    ' FileDialogオブジェクトを作成
​​    Set fileDialog = Application.FileDialog(msoFileDialogSaveAs)
​​
​​    ' ダイアログの設定
​​    With fileDialog
​​        .Title = "名前をつけて保存"
​​
​​        ' 初期ディレクトリを指定
​​        .InitialFileName = "C:\Users\YourUsername\Documents\"
​​
​​        ' フィルタを設定
​​        .Filter = "Outlook メッセージファイル (*.msg), *.msg"
​​
​​        ' デフォルトの拡張子を設定
​​        .DefaultExt = "msg"
​​
​​        ' ダイアログを表示
​​        If .Show = -1 Then
​​            ' ユーザーが「保存」を選択した場合
​​            selectedFilePath = .SelectedItems(1) ' ユーザーが指定したファイルパスを取得
​​            MsgBox "ファイルが " & selectedFilePath & " に保存されました。", vbInformation
​​        End If
​​    End With
​​End Sub