Extract meeting info from Outlook to Obsidian

obsidian.vbs

Sub ExtractMeetingInfoToObsidian()
    Dim objApp As Outlook.Application
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Dim objMeeting As Outlook.AppointmentItem
    Dim strMarkdown As String
    Dim strAttendees As String
    Dim arrAttendees() As String
    Dim i As Integer
    Dim strFileName As String
    Dim strFilePath As String
    Dim sAttendee As String
    Dim intFileNum As Integer
    
    Set objApp = Outlook.Application
    Set objSelection = objApp.ActiveExplorer.Selection
    
    If objSelection.Count = 0 Then
        MsgBox "No items selected.", vbExclamation
        Exit Sub
    End If
    
    Set objItem = objSelection.Item(1)
    
    If Not TypeOf objItem Is Outlook.AppointmentItem Then
        MsgBox "Please select a meeting item.", vbExclamation
        Exit Sub
    End If
    
    Set objMeeting = objItem
    
    ' Extract meeting information
    strMarkdown = "## " & objMeeting.Subject & vbCrLf
    strMarkdown = strMarkdown & "- Orario: " & Format(objMeeting.Start, "hh:mm") & " - " & Format(objMeeting.End, "hh:mm") & vbCrLf
    strMarkdown = strMarkdown & "- Partecipanti:" & vbCrLf
    
    ' Extract attendees
    strAttendees = objMeeting.RequiredAttendees & ";" & objMeeting.OptionalAttendees
    arrAttendees = Split(strAttendees, ";")
    
    For i = LBound(arrAttendees) To UBound(arrAttendees)
        sAttendee = Trim(arrAttendees(i))
        If sAttendee <> "" Then
            If Right(sAttendee, 4) = ", IT" Then
                sAttendee = Left(sAttendee, Len(sAttendee) - 4)
            End If
            strMarkdown = strMarkdown & vbTab & "- " & sAttendee & vbCrLf
        End If
    Next i
    
    strMarkdown = strMarkdown & vbCrLf
    
    ' Determine file name and path
    strFileName = Format(objMeeting.Start, "yyyy-mm-dd") & ".md"
    strFilePath = Environ("USERPROFILE") & "\Documents\Obsidian\Daily\" & strFileName
    
    ' Write to file
    intFileNum = FreeFile
    Open strFilePath For Append As #intFileNum
    Print #intFileNum, strMarkdown
    Close #intFileNum
    
End Sub