diff --git a/JDAdd.vb b/VBA Utilities/JDAdd.vb similarity index 100% rename from JDAdd.vb rename to VBA Utilities/JDAdd.vb diff --git a/JDRemove.vb b/VBA Utilities/JDRemove.vb similarity index 100% rename from JDRemove.vb rename to VBA Utilities/JDRemove.vb diff --git a/SaveEmail.vb b/VBA Utilities/SaveEmail.vb similarity index 97% rename from SaveEmail.vb rename to VBA Utilities/SaveEmail.vb index 9aa4324..b344734 100644 --- a/SaveEmail.vb +++ b/VBA Utilities/SaveEmail.vb @@ -1,113 +1,114 @@ -'=======================================================================================' -Sub ExtractEmail() - - Dim vaultPathToSaveFileTo As String - Dim emailFileNameStartChr As String - Dim emailTypeLink As String - Dim personNameStartChar As String - config vaultPathToSaveFileTo, personNameStartChar, emailFileNameStartChr, emailTypeLink - - '================================================' - ' Save as plain text - Const OLTXT = 0 - ' Object holding variable - Dim obj As Object - ' Instantiate an Outlook Email Object - Dim oMail As Outlook.MailItem - ' If something breaks, skip to the end, tidy up and shut the door - On Error GoTo EndClean: - ' Establish the environment and selected items (emails) - ' NOTE: selecting a conversation-view stack wont work - ' you'll need to select one of the emails - Dim fileName As String - Dim temporarySubjectLineString As String - Dim currentExplorer As Explorer - Set currentExplorer = Application.ActiveExplorer - Dim Selection As Selection - Set Selection = currentExplorer.Selection - ' For each email in the Selection - ' Assigning email item to the `obj` holding variable - For Each obj In Selection - ' set the oMail object equal to that mail item - Set oMail = obj - ' Is it an Email? - If oMail.Class <> 43 Then - MsgBox "This code only works with Emails." - GoTo EndClean: ' you broke it - End If - - ' Yank the mail items subject line to `temporarySubjectLineString` - temporarySubjectLineString = oMail.Subject - ' function call the name cleaner to remove any - ' illegal characters from the subject line - ReplaceCharsForFileName temporarySubjectLineString, "" - ' Yank the received date-time to a holding variable - - ' Build Recipient string based on receipient collection - Dim recips As Outlook.Recipients - Set recips = oMail.Recipients - Dim recip As Outlook.Recipient - Dim result As String - Dim recipString As String - recipString = "" - - For Each recip In recips - recipString = recipString & vbTab - recipString = recipString & "- " - recipString = recipString & formatName(recip.name, personNameStartChar) - recipString = recipString & vbCrLf - Next - ' Build the result file content to be sent to the mail item body - ' Then save that mail item same as the meeting extractor - Dim sender As String - sender = formatName(oMail.sender, personNameStartChar) - Dim dtDate As Date - dtDate = oMail.ReceivedTime - Dim resultString As String - - resultString = "" - resultString = resultString & "# [[" & emailFileNameStartChr & Format(oMail.ReceivedTime, "yyyy-mm-dd hhnn") & " " & temporarySubjectLineString & "|" & temporarySubjectLineString & "]]" - resultString = resultString & vbCrLf & vbCrLf & vbCrLf - - resultString = resultString & "- `From:` " & vbCrLf - resultString = resultString & vbTab & "- " & sender - resultString = resultString & vbCrLf - - resultString = resultString & "- `To:` " & vbCrLf - resultString = resultString & recipString - resultString = resultString & vbCrLf - - resultString = resultString & "- `Received:` " - resultString = resultString & "[[" & Format(oMail.ReceivedTime, "yyyy-mm-dd") & "]] " - resultString = resultString & Format(oMail.ReceivedTime, "hh:MM AM/PM") - resultString = resultString & vbCrLf - - resultString = resultString & "- `Type:` " & emailTypeLink - resultString = resultString & vbCrLf & vbCrLf & vbCrLf - - resultString = resultString & "---" - resultString = resultString & vbCrLf & vbCrLf & vbCrLf - - resultString = resultString & oMail.Body - - ' Make a dummy email to hold the details we're saving - ' This way we dont get junk in the message header when saving - Dim outputItem As MailItem - Set outputItem = Application.CreateItem(olMailItem) - outputItem.Body = resultString - - ' Now we create the file name - fileName = emailFileNameStartChr - fileName = fileName & Format(dtDate, "yyyy-mm-dd", vbUseSystemDayOfWeek, vbUseSystem) - fileName = fileName & Format(dtDate, " hhMM", vbUseSystemDayOfWeek, vbUseSystem) - fileName = fileName & " " & temporarySubjectLineString & ".md" - - ' Save the result - outputItem.SaveAs vaultPathToSaveFileTo & fileName, OLTXT - - Next -EndClean: - Set obj = Nothing - Set oMail = Nothing - Set outputItem = Nothing -End Sub +Option Explicit +'=======================================================================================' +Sub ExtractEmail() + + Dim vaultPathToSaveFileTo As String + Dim emailFileNameStartChr As String + Dim emailTypeLink As String + Dim personNameStartChar As String + config vaultPathToSaveFileTo, personNameStartChar, emailFileNameStartChr, emailTypeLink + + '================================================' + ' Save as plain text + Const OLTXT = 0 + ' Object holding variable + Dim obj As Object + ' Instantiate an Outlook Email Object + Dim oMail As Outlook.MailItem + ' If something breaks, skip to the end, tidy up and shut the door + On Error GoTo EndClean: + ' Establish the environment and selected items (emails) + ' NOTE: selecting a conversation-view stack wont work + ' you'll need to select one of the emails + Dim fileName As String + Dim temporarySubjectLineString As String + Dim currentExplorer As Explorer + Set currentExplorer = Application.ActiveExplorer + Dim Selection As Selection + Set Selection = currentExplorer.Selection + ' For each email in the Selection + ' Assigning email item to the `obj` holding variable + For Each obj In Selection + ' set the oMail object equal to that mail item + Set oMail = obj + ' Is it an Email? + If oMail.Class <> 43 Then + MsgBox "This code only works with Emails." + GoTo EndClean: ' you broke it + End If + + ' Yank the mail items subject line to `temporarySubjectLineString` + temporarySubjectLineString = oMail.Subject + ' function call the name cleaner to remove any + ' illegal characters from the subject line + ReplaceCharsForFileName temporarySubjectLineString, "" + ' Yank the received date-time to a holding variable + + ' Build Recipient string based on receipient collection + Dim recips As Outlook.Recipients + Set recips = oMail.Recipients + Dim recip As Outlook.Recipient + Dim result As String + Dim recipString As String + recipString = "" + + For Each recip In recips + recipString = recipString & vbTab + recipString = recipString & "- " + recipString = recipString & formatName(recip.name, personNameStartChar) + recipString = recipString & vbCrLf + Next + ' Build the result file content to be sent to the mail item body + ' Then save that mail item same as the meeting extractor + Dim sender As String + sender = formatName(oMail.sender, personNameStartChar) + Dim dtDate As Date + dtDate = oMail.ReceivedTime + Dim resultString As String + + resultString = "" + resultString = resultString & "# [[" & emailFileNameStartChr & Format(oMail.ReceivedTime, "yyyy-mm-dd hhnn") & " " & temporarySubjectLineString & "|" & temporarySubjectLineString & "]]" + resultString = resultString & vbCrLf & vbCrLf & vbCrLf + + resultString = resultString & "- `From:` " & vbCrLf + resultString = resultString & vbTab & "- " & sender + resultString = resultString & vbCrLf + + resultString = resultString & "- `To:` " & vbCrLf + resultString = resultString & recipString + resultString = resultString & vbCrLf + + resultString = resultString & "- `Received:` " + resultString = resultString & "[[" & Format(oMail.ReceivedTime, "yyyy-mm-dd") & "]] " + resultString = resultString & Format(oMail.ReceivedTime, "hh:MM AM/PM") + resultString = resultString & vbCrLf + + resultString = resultString & "- `Type:` " & emailTypeLink + resultString = resultString & vbCrLf & vbCrLf & vbCrLf + + resultString = resultString & "---" + resultString = resultString & vbCrLf & vbCrLf & vbCrLf + + resultString = resultString & oMail.Body + + ' Make a dummy email to hold the details we're saving + ' This way we dont get junk in the message header when saving + Dim outputItem As MailItem + Set outputItem = Application.CreateItem(olMailItem) + outputItem.Body = resultString + + ' Now we create the file name + fileName = emailFileNameStartChr + fileName = fileName & Format(dtDate, "yyyy-mm-dd", vbUseSystemDayOfWeek, vbUseSystem) + fileName = fileName & Format(dtDate, " hhMM", vbUseSystemDayOfWeek, vbUseSystem) + fileName = fileName & " " & temporarySubjectLineString & ".md" + + ' Save the result + outputItem.SaveAs vaultPathToSaveFileTo & fileName, OLTXT + + Next +EndClean: + Set obj = Nothing + Set oMail = Nothing + Set outputItem = Nothing +End Sub diff --git a/SaveMeeting.vb b/VBA Utilities/SaveMeeting.vb similarity index 97% rename from SaveMeeting.vb rename to VBA Utilities/SaveMeeting.vb index 83fdaa4..05c4600 100644 --- a/SaveMeeting.vb +++ b/VBA Utilities/SaveMeeting.vb @@ -1,177 +1,177 @@ -Option Explicit -'=======================================================================================' -Sub GetAttendeeList(meetingType As String) - - Dim vaultPathToSaveFileTo As String - Dim personNameStartChar As String - - - Dim trainingFileNameStartChr As String - Dim trainingTypeLink As String - - Dim meetingFileNameStartChr As String - Dim meetingTypeLink As String - - Dim fileNameStartChr As String - Dim typeLink As String - - - Select Case meetingType - Case "Meeting" - config vaultPathToSaveFileTo, personNameStartChar, , , meetingFileNameStartChr, meetingTypeLink - ' use the meeting data variables - fileNameStartChr = meetingFileNameStartChr - typeLink = meetingTypeLink - Case "Training" - config vaultPathToSaveFileTo, personNameStartChar, , , , , trainingFileNameStartChr, trainingTypeLink - ' use the training data variables - fileNameStartChr = trainingFileNameStartChr - typeLink = trainingTypeLink - End Select - - - - ' Instantiate an Outlook application instanc - Dim objApp As Outlook.Application - Set objApp = CreateObject("Outlook.Application") - ' Grab the currently selected item by using the function declare above - Dim objItem As Object - Set objItem = GetCurrentItem() - Dim objAttendees As Outlook.Recipients - ' For the currently selected item, we're getting a copy of the recipients - Set objAttendees = objItem.Recipients - - ' If something breaks, skip to the end, tidy up and shut the door - On Error GoTo EndClean: - - ' Is it an appointment - If objItem.Class <> 26 Then - MsgBox "This code only works with meetings." - GoTo EndClean: ' you broke it - End If - '======================================================= - ' Get the data - Dim dtStart As Date - dtStart = objItem.Start - - Dim dtEnd As Date - dtEnd = objItem.End - - Dim strSubject As String - strSubject = objItem.Subject - ' Clean up meeting title of invalid characters - ReplaceCharsForFileName strSubject, "" - - Dim strLocation As String - strLocation = objItem.Location - - Dim strNotes As String - strNotes = objItem.Body - - Dim objOrganizer As String - objOrganizer = objItem.Organizer - - Dim objAttendeeReq As String - objAttendeeReq = "" - - Dim objAttendeeOpt As String - objAttendeeOpt = "" - '======================================================= - ' ListAttendees is really just an email item now - Dim ListAttendees As MailItem - Set ListAttendees = Application.CreateItem(olMailItem) - '======================================================= - ' Get The Attendee List - Dim x As Long - Dim attendeeName As String - ' For each recipient on the selected meeting - For x = 1 To objAttendees.Count - ' For `REQUIRED` Attendee's Separate them out - If objAttendees(x).Type = olRequired Then - ' Format Names of attendees correctly - attendeeName = formatName(objAttendees(x).name, personNameStartChar) - ' Building a long formatted string with records that look like: - ' - [[@Bryan Jenks]]\n - objAttendeeReq = objAttendeeReq & vbTab - objAttendeeReq = objAttendeeReq & "- " - objAttendeeReq = objAttendeeReq & attendeeName - objAttendeeReq = objAttendeeReq & vbCrLf - Else ' For `OPTIONAL` Attendee's Separate them out - ' Format optional Attendee names - attendeeName = formatName(objAttendees(x).name, personNameStartChar) - - objAttendeeOpt = objAttendeeOpt & vbTab - objAttendeeOpt = objAttendeeOpt & "- " - objAttendeeOpt = objAttendeeOpt & attendeeName - objAttendeeOpt = objAttendeeOpt & vbCrLf - End If - Next - '======================================================= - Dim strCopyData As String - - ' Begin building the final plain text report out - - strCopyData = "" - strCopyData = strCopyData & "# [[" & fileNameStartChr & Format(dtStart, "yyyy-mm-dd hhMM") & " " & strSubject & "|" & strSubject & "]]" - strCopyData = strCopyData & vbCrLf & vbCrLf & vbCrLf - - strCopyData = strCopyData & "- `Organizer:` " & formatName(objOrganizer, personNameStartChar) - strCopyData = strCopyData & vbCrLf - - strCopyData = strCopyData & "- `Location:` " & "[[" & strLocation & "]]" - strCopyData = strCopyData & vbCrLf - - strCopyData = strCopyData & "- `Start:` " - strCopyData = strCopyData & "[[" & Format(dtStart, "yyyy-mm-dd") & "]] " & Format(dtStart, "hh:MM:ss AM/PM") - strCopyData = strCopyData & vbCrLf - - strCopyData = strCopyData & "- `End:` " - strCopyData = strCopyData & "[[" & Format(dtEnd, "yyyy-mm-dd") & "]] " & Format(dtEnd, "hh:MM:ss AM/PM") - strCopyData = strCopyData & vbCrLf & vbCrLf - - - strCopyData = strCopyData & "- `Type:` " & typeLink - strCopyData = strCopyData & vbCrLf & vbCrLf - - - strCopyData = strCopyData & "- `Required:` " - strCopyData = strCopyData & vbCrLf - strCopyData = strCopyData & objAttendeeReq - strCopyData = strCopyData & vbCrLf - - strCopyData = strCopyData & "- `Optional:` " - strCopyData = strCopyData & vbCrLf - strCopyData = strCopyData & objAttendeeOpt - strCopyData = strCopyData & vbCrLf & vbCrLf - - strCopyData = strCopyData & "#### NOTES " - strCopyData = strCopyData & vbCrLf & vbCrLf - strCopyData = strCopyData & vbCrLf - strCopyData = strCopyData & strNotes - - - Const OLTXT = 0 - - ' Put the output into the Email item body - ListAttendees.Body = strCopyData - - Dim fileName As String - fileName = fileNameStartChr & Format(dtStart, "yyyy-mm-dd hhMM") & " " & strSubject & ".md" - - ListAttendees.SaveAs vaultPathToSaveFileTo & fileName, OLTXT - - - ' Tidy up and shut the door -EndClean: - Set objApp = Nothing - Set objItem = Nothing - Set objAttendees = Nothing -End Sub - -Sub ExtractMeeting() - GetAttendeeList "Meeting" -End Sub - -Sub ExtractTraining() - GetAttendeeList "Training" -End Sub +Option Explicit +'=======================================================================================' +Sub GetAttendeeList(meetingType As String) + + Dim vaultPathToSaveFileTo As String + Dim personNameStartChar As String + + + Dim trainingFileNameStartChr As String + Dim trainingTypeLink As String + + Dim meetingFileNameStartChr As String + Dim meetingTypeLink As String + + Dim fileNameStartChr As String + Dim typeLink As String + + + Select Case meetingType + Case "Meeting" + config vaultPathToSaveFileTo, personNameStartChar, , , meetingFileNameStartChr, meetingTypeLink + ' use the meeting data variables + fileNameStartChr = meetingFileNameStartChr + typeLink = meetingTypeLink + Case "Training" + config vaultPathToSaveFileTo, personNameStartChar, , , , , trainingFileNameStartChr, trainingTypeLink + ' use the training data variables + fileNameStartChr = trainingFileNameStartChr + typeLink = trainingTypeLink + End Select + + + + ' Instantiate an Outlook application instanc + Dim objApp As Outlook.Application + Set objApp = CreateObject("Outlook.Application") + ' Grab the currently selected item by using the function declare above + Dim objItem As Object + Set objItem = GetCurrentItem() + Dim objAttendees As Outlook.Recipients + ' For the currently selected item, we're getting a copy of the recipients + Set objAttendees = objItem.Recipients + + ' If something breaks, skip to the end, tidy up and shut the door + On Error GoTo EndClean: + + ' Is it an appointment + If objItem.Class <> 26 Then + MsgBox "This code only works with meetings." + GoTo EndClean: ' you broke it + End If + '======================================================= + ' Get the data + Dim dtStart As Date + dtStart = objItem.Start + + Dim dtEnd As Date + dtEnd = objItem.End + + Dim strSubject As String + strSubject = objItem.Subject + ' Clean up meeting title of invalid characters + ReplaceCharsForFileName strSubject, "" + + Dim strLocation As String + strLocation = objItem.Location + + Dim strNotes As String + strNotes = objItem.Body + + Dim objOrganizer As String + objOrganizer = objItem.Organizer + + Dim objAttendeeReq As String + objAttendeeReq = "" + + Dim objAttendeeOpt As String + objAttendeeOpt = "" + '======================================================= + ' ListAttendees is really just an email item now + Dim ListAttendees As MailItem + Set ListAttendees = Application.CreateItem(olMailItem) + '======================================================= + ' Get The Attendee List + Dim x As Long + Dim attendeeName As String + ' For each recipient on the selected meeting + For x = 1 To objAttendees.Count + ' For `REQUIRED` Attendee's Separate them out + If objAttendees(x).Type = olRequired Then + ' Format Names of attendees correctly + attendeeName = formatName(objAttendees(x).name, personNameStartChar) + ' Building a long formatted string with records that look like: + ' - [[@Bryan Jenks]]\n + objAttendeeReq = objAttendeeReq & vbTab + objAttendeeReq = objAttendeeReq & "- " + objAttendeeReq = objAttendeeReq & attendeeName + objAttendeeReq = objAttendeeReq & vbCrLf + Else ' For `OPTIONAL` Attendee's Separate them out + ' Format optional Attendee names + attendeeName = formatName(objAttendees(x).name, personNameStartChar) + + objAttendeeOpt = objAttendeeOpt & vbTab + objAttendeeOpt = objAttendeeOpt & "- " + objAttendeeOpt = objAttendeeOpt & attendeeName + objAttendeeOpt = objAttendeeOpt & vbCrLf + End If + Next + '======================================================= + Dim strCopyData As String + + ' Begin building the final plain text report out + + strCopyData = "" + strCopyData = strCopyData & "# [[" & fileNameStartChr & Format(dtStart, "yyyy-mm-dd hhMM") & " " & strSubject & "|" & strSubject & "]]" + strCopyData = strCopyData & vbCrLf & vbCrLf & vbCrLf + + strCopyData = strCopyData & "- `Organizer:` " & formatName(objOrganizer, personNameStartChar) + strCopyData = strCopyData & vbCrLf + + strCopyData = strCopyData & "- `Location:` " & "[[" & strLocation & "]]" + strCopyData = strCopyData & vbCrLf + + strCopyData = strCopyData & "- `Start:` " + strCopyData = strCopyData & "[[" & Format(dtStart, "yyyy-mm-dd") & "]] " & Format(dtStart, "hh:MM:ss AM/PM") + strCopyData = strCopyData & vbCrLf + + strCopyData = strCopyData & "- `End:` " + strCopyData = strCopyData & "[[" & Format(dtEnd, "yyyy-mm-dd") & "]] " & Format(dtEnd, "hh:MM:ss AM/PM") + strCopyData = strCopyData & vbCrLf & vbCrLf + + + strCopyData = strCopyData & "- `Type:` " & typeLink + strCopyData = strCopyData & vbCrLf & vbCrLf + + + strCopyData = strCopyData & "- `Required:` " + strCopyData = strCopyData & vbCrLf + strCopyData = strCopyData & objAttendeeReq + strCopyData = strCopyData & vbCrLf + + strCopyData = strCopyData & "- `Optional:` " + strCopyData = strCopyData & vbCrLf + strCopyData = strCopyData & objAttendeeOpt + strCopyData = strCopyData & vbCrLf & vbCrLf + + strCopyData = strCopyData & "#### NOTES " + strCopyData = strCopyData & vbCrLf & vbCrLf + strCopyData = strCopyData & vbCrLf + strCopyData = strCopyData & strNotes + + + Const OLTXT = 0 + + ' Put the output into the Email item body + ListAttendees.Body = strCopyData + + Dim fileName As String + fileName = fileNameStartChr & Format(dtStart, "yyyy-mm-dd hhMM") & " " & strSubject & ".md" + + ListAttendees.SaveAs vaultPathToSaveFileTo & fileName, OLTXT + + + ' Tidy up and shut the door +EndClean: + Set objApp = Nothing + Set objItem = Nothing + Set objAttendees = Nothing +End Sub + +Sub ExtractMeeting() + GetAttendeeList "Meeting" +End Sub + +Sub ExtractTraining() + GetAttendeeList "Training" +End Sub diff --git a/SaveUtilities.vb b/VBA Utilities/SaveUtilities.vb similarity index 100% rename from SaveUtilities.vb rename to VBA Utilities/SaveUtilities.vb diff --git a/USER_CONFIG.vb b/VBA Utilities/USER_CONFIG.vb similarity index 96% rename from USER_CONFIG.vb rename to VBA Utilities/USER_CONFIG.vb index ce8b3d6..e65d31d 100644 --- a/USER_CONFIG.vb +++ b/VBA Utilities/USER_CONFIG.vb @@ -6,7 +6,7 @@ Public Sub config(vaultPathToSaveFileTo As String, personNameStartChar As String '================================================' ' Make sure this is the absolute path where you want your files to be sent to ' !IMPORTANT! make sure you have a trailing backslash at the end of the path `\` - vaultPathToSaveFileTo = "C:\Users\bjenks\OneDrive - Covered California\Desktop\" + vaultPathToSaveFileTo = "C:\Users\bjenks\Desktop\Vault\" '================================================' ' This is what is added to the links inside the produced documents for people ' so it would look like: @@ -18,6 +18,9 @@ Public Sub config(vaultPathToSaveFileTo As String, personNameStartChar As String ' ^^^^^^^^^^^^^^^^^^^^^^^ ' THE ABOVE ARE MANDATORY ' + ' + ' + ' ' THE BELOW ARE OPTIONAL ' VVVVVVVVVVVVVVVVVVVVVVV