From 38f094c5fb64fc1376b043408ef6f0bf3cda7471 Mon Sep 17 00:00:00 2001 From: Alex Reed Date: Fri, 28 Feb 2020 18:28:56 -0800 Subject: [PATCH] Add outlook changes --- .../Excel to Outlook - Charts.bas} | 264 +++++----- .../Excel to Outlook - Ranges.bas} | 300 +++++------ .../Excel to Outlook - Tables.bas} | 493 +++++++++--------- .../Outlook - Appointment Object.bas | 86 +++ .../Outlook - Folder Object.bas} | 176 +++---- .../Outlook - Mailitem Object.bas} | 212 ++++---- .../Outlook - Namespace Object.bas} | 142 ++--- .../Outlook to Excel - Tables.bas} | 0 8 files changed, 879 insertions(+), 794 deletions(-) rename vba/{outlook-vba/Excel Chart To Outlook.bas => vba-outlook/Excel to Outlook - Charts.bas} (96%) rename vba/{outlook-vba/Excel Range To Outlook.bas => vba-outlook/Excel to Outlook - Ranges.bas} (96%) rename vba/{outlook-vba/Excel Table To Outlook.bas => vba-outlook/Excel to Outlook - Tables.bas} (96%) create mode 100644 vba/vba-outlook/Outlook - Appointment Object.bas rename vba/{outlook-vba/Folder Object.bas => vba-outlook/Outlook - Folder Object.bas} (97%) rename vba/{outlook-vba/Mailitem Object.bas => vba-outlook/Outlook - Mailitem Object.bas} (96%) rename vba/{outlook-vba/Namespace Object.bas => vba-outlook/Outlook - Namespace Object.bas} (96%) rename vba/{outlook-vba/Outlook Table to Excel.bas => vba-outlook/Outlook to Excel - Tables.bas} (100%) diff --git a/vba/outlook-vba/Excel Chart To Outlook.bas b/vba/vba-outlook/Excel to Outlook - Charts.bas similarity index 96% rename from vba/outlook-vba/Excel Chart To Outlook.bas rename to vba/vba-outlook/Excel to Outlook - Charts.bas index 4279f81..d92df70 100644 --- a/vba/outlook-vba/Excel Chart To Outlook.bas +++ b/vba/vba-outlook/Excel to Outlook - Charts.bas @@ -1,132 +1,132 @@ -Attribute VB_Name = "Module1" -Sub ChartToOutlook_Multi() - - 'Declare Outlook Variables - Dim oLookApp As Outlook.Application - Dim oLookFdr As Outlook.Folder - Dim oLookNsp As Outlook.Namespace - Dim oLookItm As Outlook.MailItem - - 'Declare Excel Variables - Dim ChrObj As ChartObject - - On Error Resume Next - - 'Test if Outlook is Open - Set oLookApp = GetObject(, "Outlook.Application") - - 'If the Application isn't open it will return a 429 error - If Err.Number = 429 Then - - 'If it is not open then clear the error and create a new instance of Outlook - Err.Clear - Set oLookApp = New Outlook.Application - - End If - - 'Create a mail item in outlook. - Set oLookItm = oLookApp.CreateItem(olMailItem) - - 'With the new email we just created. - With oLookItm - - 'Define basic infromation about the email - .To = "xyz@anc.com" - .CC = "abc@xyz.com" - .Subject = "Test" - .Body = "Dear Mr Lee" & vbNewLine - - 'Show the new email. - .Display - - 'Get the Word Editor - Set oWdEditor = .GetInspector.WordEditor - - 'Loop through each chart in the active sheet - For Each ChrObj In ActiveSheet.ChartObjects - - 'Copy the Chart - ChrObj.Chart.ChartArea.Copy - - 'Define the range, insert a blank line, collapse the selection. - Set oWdRng = oWdEditor.Application.ActiveDocument.Content - oWdRng.InsertAfter " " & vbNewLine - oWdRng.Collapse Direction:=wdCollapseEnd - - 'Paste the object. - oWdRng.Paste - - Next - - End With - -End Sub - -Sub ChartToOutlook_single() - - 'Declare Outlook Variables - Dim oLookApp As Outlook.Application - Dim oLookFdr As Outlook.Folder - Dim oLookNsp As Outlook.Namespace - Dim oLookItm As Outlook.MailItem - - - 'Declare Excel Variables - Dim ChrObj As ChartObject - - On Error Resume Next - - 'Test if Outlook is Open - Set oLookApp = GetObject(, "Outlook.Application") - - 'If the Application isn't open it will return a 429 error - If Err.Number = 429 Then - - 'If it is not open then clear the error and create a new instance of Outlook - Err.Clear - Set oLookApp = New Outlook.Application - -' 'Create a NameSpace -' Set oLookNsp = oLookApp.GetNamespace("MAPI") -' -' 'Create an Outlook Session and get the default folder. -' Set oLookFdr = oLookApp.Session.GetDefaultFolder(olFolderInbox) -' oLookFdr.Display - - End If - - 'Create a reference to the chart and copy it. - Set ChrObj = ActiveSheet.ChartObjects(1) - ChrObj.Chart.ChartArea.Copy - - 'Create a mail item in outlook. - Set oLookItm = oLookApp.CreateItem(olMailItem) - - 'With the new email we just created. - With oLookItm - - 'Define basic infromation about the email - .To = "xyz@anc.com" - .CC = "abc@xyz.com" - .Subject = "Test" - .Body = "Dear Mr Lee" & vbNewLine - - 'Show the new email. - .Display - - 'Get the Word Editor - Set oWdEditor = .GetInspector.WordEditor - - 'Define the range, insert a blank line, collapse the selection. - Set oWdRng = oWdEditor.Application.ActiveDocument.Content - oWdRng.InsertAfter " " & vbNewLine - oWdRng.Collapse Direction:=wdCollapseEnd - - 'Paste the object. - oWdRng.Paste - - End With - -End Sub - - +Attribute VB_Name = "Module1" +Sub ChartToOutlook_Multi() + + 'Declare Outlook Variables + Dim oLookApp As Outlook.Application + Dim oLookFdr As Outlook.Folder + Dim oLookNsp As Outlook.Namespace + Dim oLookItm As Outlook.MailItem + + 'Declare Excel Variables + Dim ChrObj As ChartObject + + On Error Resume Next + + 'Test if Outlook is Open + Set oLookApp = GetObject(, "Outlook.Application") + + 'If the Application isn't open it will return a 429 error + If Err.Number = 429 Then + + 'If it is not open then clear the error and create a new instance of Outlook + Err.Clear + Set oLookApp = New Outlook.Application + + End If + + 'Create a mail item in outlook. + Set oLookItm = oLookApp.CreateItem(olMailItem) + + 'With the new email we just created. + With oLookItm + + 'Define basic infromation about the email + .To = "xyz@anc.com" + .CC = "abc@xyz.com" + .Subject = "Test" + .Body = "Dear Mr Lee" & vbNewLine + + 'Show the new email. + .Display + + 'Get the Word Editor + Set oWdEditor = .GetInspector.WordEditor + + 'Loop through each chart in the active sheet + For Each ChrObj In ActiveSheet.ChartObjects + + 'Copy the Chart + ChrObj.Chart.ChartArea.Copy + + 'Define the range, insert a blank line, collapse the selection. + Set oWdRng = oWdEditor.Application.ActiveDocument.Content + oWdRng.InsertAfter " " & vbNewLine + oWdRng.Collapse Direction:=wdCollapseEnd + + 'Paste the object. + oWdRng.Paste + + Next + + End With + +End Sub + +Sub ChartToOutlook_single() + + 'Declare Outlook Variables + Dim oLookApp As Outlook.Application + Dim oLookFdr As Outlook.Folder + Dim oLookNsp As Outlook.Namespace + Dim oLookItm As Outlook.MailItem + + + 'Declare Excel Variables + Dim ChrObj As ChartObject + + On Error Resume Next + + 'Test if Outlook is Open + Set oLookApp = GetObject(, "Outlook.Application") + + 'If the Application isn't open it will return a 429 error + If Err.Number = 429 Then + + 'If it is not open then clear the error and create a new instance of Outlook + Err.Clear + Set oLookApp = New Outlook.Application + +' 'Create a NameSpace +' Set oLookNsp = oLookApp.GetNamespace("MAPI") +' +' 'Create an Outlook Session and get the default folder. +' Set oLookFdr = oLookApp.Session.GetDefaultFolder(olFolderInbox) +' oLookFdr.Display + + End If + + 'Create a reference to the chart and copy it. + Set ChrObj = ActiveSheet.ChartObjects(1) + ChrObj.Chart.ChartArea.Copy + + 'Create a mail item in outlook. + Set oLookItm = oLookApp.CreateItem(olMailItem) + + 'With the new email we just created. + With oLookItm + + 'Define basic infromation about the email + .To = "xyz@anc.com" + .CC = "abc@xyz.com" + .Subject = "Test" + .Body = "Dear Mr Lee" & vbNewLine + + 'Show the new email. + .Display + + 'Get the Word Editor + Set oWdEditor = .GetInspector.WordEditor + + 'Define the range, insert a blank line, collapse the selection. + Set oWdRng = oWdEditor.Application.ActiveDocument.Content + oWdRng.InsertAfter " " & vbNewLine + oWdRng.Collapse Direction:=wdCollapseEnd + + 'Paste the object. + oWdRng.Paste + + End With + +End Sub + + diff --git a/vba/outlook-vba/Excel Range To Outlook.bas b/vba/vba-outlook/Excel to Outlook - Ranges.bas similarity index 96% rename from vba/outlook-vba/Excel Range To Outlook.bas rename to vba/vba-outlook/Excel to Outlook - Ranges.bas index 6776a44..383f4b6 100644 --- a/vba/outlook-vba/Excel Range To Outlook.bas +++ b/vba/vba-outlook/Excel to Outlook - Ranges.bas @@ -1,150 +1,150 @@ -Attribute VB_Name = "Module2" -Sub RangeToOutlook_Single() - - 'Declare Outlook Variables - Dim oLookApp As Outlook.Application - Dim oLookItm As Outlook.MailItem - Dim oLookIns As Outlook.Inspector - - 'Declare Word Variables - Dim oWrdDoc As Word.Document - Dim oWrdRng As Word.Range - - 'Delcare Excel Variables - Dim ExcRng As Range - - On Error Resume Next - - 'Get the Active instance of Outlook if there is one - Set oLookApp = GetObject(, "Outlook.Application") - - 'If Outlook isn't open then create a new instance of Outlook - If Err.Number = 429 Then - - 'Clear Error - Err.Clear - - 'Create a new instance of Outlook - Set oLookApp = New Outlook.Application - - End If - - 'Create a new email - Set oLookItm = oLookApp.CreateItem(olMailItem) - - - 'Create an array to hold ranges - Set ExcRng = Sheet1.Range("B2:C7") - - With oLookItm - - 'Define some basic info of our email - .To = "xyz@abc.com" - .CC = "xyz@abc.com" - .Subject = "Here are all of my Ranges" - .Body = "Here are all the Ranges from my worksheet." - - 'Display the email - .Display - - 'Get the Active Inspector - Set oLookIns = .GetInspector - - 'Get the document within the inspector - Set oWrdDoc = oLookIns.WordEditor - - - ExcRng.Copy - - 'Define the range, insert a blank line, collapse the selection. - Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content - oWrdRng.Collapse Direction:=wdCollapseEnd - - 'Add a new paragragp and then a break - Set oWrdRng = oWdEditor.Paragraphs.Add - oWrdRng.InsertBreak - - 'Paste the object. - oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture - - - End With - - -End Sub - - -Sub RangeToOutlook_Multi() - - 'Declare Outlook Variables - Dim oLookApp As Outlook.Application - Dim oLookItm As Outlook.MailItem - Dim oLookIns As Outlook.Inspector - - 'Declare Word Variables - Dim oWrdDoc As Word.Document - Dim oWrdRng As Word.Range - - 'Delcare Excel Variables - Dim RngArray As Variant - - On Error Resume Next - - 'Get the Active instance of Outlook if there is one - Set oLookApp = GetObject(, "Outlook.Application") - - 'If Outlook isn't open then create a new instance of Outlook - If Err.Number = 429 Then - - 'Clear Error - Err.Clear - - 'Create a new instance of Outlook - Set oLookApp = New Outlook.Application - - End If - - 'Create a new email - Set oLookItm = oLookApp.CreateItem(olMailItem) - - - 'Create an array to hold ranges - RngArray = Array(Sheet1.Range("B2:C7"), Sheet2.Range("A1:B6")) - - With oLookItm - - 'Define some basic info of our email - .To = "xyz@abc.com" - .CC = "xyz@abc.com" - .Subject = "Here are all of my Ranges" - .Body = "Here are all the Ranges from my worksheet." - - 'Display the email - .Display - - 'Get the Active Inspector - Set oLookIns = .GetInspector - - 'Get the document within the inspector - Set oWrdDoc = oLookIns.WordEditor - - For Each Item In RngArray - - Item.Copy - - 'Define the range, insert a blank line, collapse the selection. - Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content - oWrdRng.Collapse Direction:=wdCollapseEnd - - 'Add a new paragragp and then a break - Set oWrdRng = oWdEditor.Paragraphs.Add - oWrdRng.InsertBreak - - 'Paste the object. - oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture - - Next - - End With - -End Sub +Attribute VB_Name = "Module2" +Sub RangeToOutlook_Single() + + 'Declare Outlook Variables + Dim oLookApp As Outlook.Application + Dim oLookItm As Outlook.MailItem + Dim oLookIns As Outlook.Inspector + + 'Declare Word Variables + Dim oWrdDoc As Word.Document + Dim oWrdRng As Word.Range + + 'Delcare Excel Variables + Dim ExcRng As Range + + On Error Resume Next + + 'Get the Active instance of Outlook if there is one + Set oLookApp = GetObject(, "Outlook.Application") + + 'If Outlook isn't open then create a new instance of Outlook + If Err.Number = 429 Then + + 'Clear Error + Err.Clear + + 'Create a new instance of Outlook + Set oLookApp = New Outlook.Application + + End If + + 'Create a new email + Set oLookItm = oLookApp.CreateItem(olMailItem) + + + 'Create an array to hold ranges + Set ExcRng = Sheet1.Range("B2:C7") + + With oLookItm + + 'Define some basic info of our email + .To = "xyz@abc.com" + .CC = "xyz@abc.com" + .Subject = "Here are all of my Ranges" + .Body = "Here are all the Ranges from my worksheet." + + 'Display the email + .Display + + 'Get the Active Inspector + Set oLookIns = .GetInspector + + 'Get the document within the inspector + Set oWrdDoc = oLookIns.WordEditor + + + ExcRng.Copy + + 'Define the range, insert a blank line, collapse the selection. + Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content + oWrdRng.Collapse Direction:=wdCollapseEnd + + 'Add a new paragragp and then a break + Set oWrdRng = oWdEditor.Paragraphs.Add + oWrdRng.InsertBreak + + 'Paste the object. + oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture + + + End With + + +End Sub + + +Sub RangeToOutlook_Multi() + + 'Declare Outlook Variables + Dim oLookApp As Outlook.Application + Dim oLookItm As Outlook.MailItem + Dim oLookIns As Outlook.Inspector + + 'Declare Word Variables + Dim oWrdDoc As Word.Document + Dim oWrdRng As Word.Range + + 'Delcare Excel Variables + Dim RngArray As Variant + + On Error Resume Next + + 'Get the Active instance of Outlook if there is one + Set oLookApp = GetObject(, "Outlook.Application") + + 'If Outlook isn't open then create a new instance of Outlook + If Err.Number = 429 Then + + 'Clear Error + Err.Clear + + 'Create a new instance of Outlook + Set oLookApp = New Outlook.Application + + End If + + 'Create a new email + Set oLookItm = oLookApp.CreateItem(olMailItem) + + + 'Create an array to hold ranges + RngArray = Array(Sheet1.Range("B2:C7"), Sheet2.Range("A1:B6")) + + With oLookItm + + 'Define some basic info of our email + .To = "xyz@abc.com" + .CC = "xyz@abc.com" + .Subject = "Here are all of my Ranges" + .Body = "Here are all the Ranges from my worksheet." + + 'Display the email + .Display + + 'Get the Active Inspector + Set oLookIns = .GetInspector + + 'Get the document within the inspector + Set oWrdDoc = oLookIns.WordEditor + + For Each Item In RngArray + + Item.Copy + + 'Define the range, insert a blank line, collapse the selection. + Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content + oWrdRng.Collapse Direction:=wdCollapseEnd + + 'Add a new paragragp and then a break + Set oWrdRng = oWdEditor.Paragraphs.Add + oWrdRng.InsertBreak + + 'Paste the object. + oWrdRng.PasteSpecial DataType:=wdPasteMetafilePicture + + Next + + End With + +End Sub diff --git a/vba/outlook-vba/Excel Table To Outlook.bas b/vba/vba-outlook/Excel to Outlook - Tables.bas similarity index 96% rename from vba/outlook-vba/Excel Table To Outlook.bas rename to vba/vba-outlook/Excel to Outlook - Tables.bas index 3ef3509..5accd3e 100644 --- a/vba/outlook-vba/Excel Table To Outlook.bas +++ b/vba/vba-outlook/Excel to Outlook - Tables.bas @@ -1,247 +1,246 @@ -Attribute VB_Name = "Practice" -Sub TableToOutlook_Single() - - 'Declare Outlook Variables - Dim oLookApp As Outlook.Application - Dim oLookItm As Outlook.MailItem - Dim oLookIns As Outlook.Inspector - - 'Declare Word Variables - Dim oWrdDoc As Word.Document - Dim oWrdRng As Word.Range - Dim oWrdTbl As Word.Table - - 'Delcare Excel Variables - Dim ExcTbl As ListObject - - On Error Resume Next - - 'Get the Active instance of Outlook if there is one - Set oLookApp = GetObject(, "Outlook.Application") - - 'If Outlook isn't open then create a new instance of Outlook - If Err.Number = 429 Then - - 'Clear Error - Err.Clear - - 'Create a new instance of Outlook - Set oLookApp = New Outlook.Application - - End If - - 'Create a new email - Set oLookItm = oLookApp.CreateItem(olMailItem) - - 'Create a reference to the Excel Table - Set ExcTbl = Sheet1.ListObjects(1) - - With oLookItm - - 'Define some basic info of our email - .To = "xyz@abc.com" - .CC = "xyz@abc.com" - .Subject = "Here are all of my Ranges" - .Body = "Here are all the Ranges from my worksheet." - - 'Display the email - .Display - - 'Get the Active Inspector - Set oLookIns = .GetInspector - - 'Get the document within the inspector - Set oWrdDoc = oLookIns.WordEditor - - 'Copy the table - ExcTbl.Range.Copy - - 'Define the range, insert a blank line, collapse the selection. - Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content - oWrdRng.Collapse Direction:=wdCollapseEnd - - 'Add a new paragragp and then a break - Set oWrdRng = oWdEditor.Paragraphs.Add - oWrdRng.InsertBreak - - 'Paste the object. - oWrdRng.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True - - 'Create a reference to the Word Table - Set oWrdTbl = oWrdDoc.Tables(oWrdDoc.Tables.Count) - - 'Make sure it fits to the email length - oWrdTbl.AllowAutoFit = True - oWrdTbl.AutoFitBehavior (wdAutoFitWindow) - - End With - - -End Sub - - -Sub TableToOutlook_Multi_Sheet() - - 'Declare Outlook Variables - Dim oLookApp As Outlook.Application - Dim oLookItm As Outlook.MailItem - Dim oLookIns As Outlook.Inspector - - 'Declare Word Variables - Dim oWrdDoc As Word.Document - Dim oWrdRng As Word.Range - Dim oWrdTbl As Word.Table - - 'Delcare Excel Variables - Dim ExcTbl As ListObject - Dim WrkSht As Worksheet - - On Error Resume Next - - 'Get the Active instance of Outlook if there is one - Set oLookApp = GetObject(, "Outlook.Application") - - 'If Outlook isn't open then create a new instance of Outlook - If Err.Number = 429 Then - - 'Clear Error - Err.Clear - - 'Create a new instance of Outlook - Set oLookApp = New Outlook.Application - - End If - - 'Create a new email - Set oLookItm = oLookApp.CreateItem(olMailItem) - - With oLookItm - - 'Define some basic info of our email - .To = "xyz@abc.com" - .CC = "xyz@abc.com" - .Subject = "Here are all of my Ranges" - .Body = "Here are all the Ranges from my worksheet." - - 'Display the email - .Display - - 'Get the Active Inspector - Set oLookIns = .GetInspector - - 'Get the document within the inspector - Set oWrdDoc = oLookIns.WordEditor - - For Each ExcTbl In ActiveSheet.ListObjects - - 'Copy the table - ExcTbl.Range.Copy - - 'Define the range, insert a blank line, collapse the selection. - Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content - oWrdRng.Collapse Direction:=wdCollapseEnd - - 'Add a new paragragp and then a break - Set oWrdRng = oWdEditor.Paragraphs.Add - oWrdRng.InsertBreak - - 'Paste the object. - oWrdRng.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True - - 'Create a reference to the Word Table - Set oWrdTbl = oWrdDoc.Tables(oWrdDoc.Tables.Count) - - 'Make sure it fits to the email length - oWrdTbl.AllowAutoFit = True - oWrdTbl.AutoFitBehavior (wdAutoFitWindow) - - Next - - End With - -End Sub -Sub TableToOutlook_Multi_Book() - - 'Declare Outlook Variables - Dim oLookApp As Outlook.Application - Dim oLookItm As Outlook.MailItem - Dim oLookIns As Outlook.Inspector - - 'Declare Word Variables - Dim oWrdDoc As Word.Document - Dim oWrdRng As Word.Range - Dim oWrdTbl As Word.Table - - 'Delcare Excel Variables - Dim ExcTbl As ListObject - Dim WrkSht As Worksheet - - On Error Resume Next - - 'Get the Active instance of Outlook if there is one - Set oLookApp = GetObject(, "Outlook.Application") - - 'If Outlook isn't open then create a new instance of Outlook - If Err.Number = 429 Then - - 'Clear Error - Err.Clear - - 'Create a new instance of Outlook - Set oLookApp = New Outlook.Application - - End If - - 'Create a new email - Set oLookItm = oLookApp.CreateItem(olMailItem) - - With oLookItm - - 'Define some basic info of our email - .To = "xyz@abc.com" - .CC = "xyz@abc.com" - .Subject = "Here are all of my Ranges" - .Body = "Here are all the Ranges from my worksheet." - - 'Display the email - .Display - - 'Get the Active Inspector - Set oLookIns = .GetInspector - - 'Get the document within the inspector - Set oWrdDoc = oLookIns.WordEditor - - For Each WrkSht In ActiveWorkbook.Worksheets - For Each ExcTbl In WrkSht.ListObjects - - 'Copy the table - ExcTbl.Range.Copy - - 'Define the range, insert a blank line, collapse the selection. - Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content - oWrdRng.Collapse Direction:=wdCollapseEnd - - 'Add a new paragragp and then a break - Set oWrdRng = oWdEditor.Paragraphs.Add - oWrdRng.InsertBreak - - 'Paste the object. - oWrdRng.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True - - 'Create a reference to the Word Table - Set oWrdTbl = oWrdDoc.Tables(oWrdDoc.Tables.Count) - - 'Make sure it fits to the email length - oWrdTbl.AllowAutoFit = True - oWrdTbl.AutoFitBehavior (wdAutoFitWindow) - oWrdTbl.Style = wdStyleTableDarkList - oWrdTbl.BottomPadding = PixelsToPoints(10, True) - oWrdTbl.TopPadding = PixelsToPoints(10, True) - Next - Next - - End With - -End Sub - +Sub TableToOutlook_Single() + + 'Declare Outlook Variables + Dim oLookApp As Outlook.Application + Dim oLookItm As Outlook.MailItem + Dim oLookIns As Outlook.Inspector + + 'Declare Word Variables + Dim oWrdDoc As Word.Document + Dim oWrdRng As Word.Range + Dim oWrdTbl As Word.Table + + 'Delcare Excel Variables + Dim ExcTbl As ListObject + + On Error Resume Next + + 'Get the Active instance of Outlook if there is one + Set oLookApp = GetObject(, "Outlook.Application") + + 'If Outlook isn't open then create a new instance of Outlook + If Err.Number = 429 Then + + 'Clear Error + Err.Clear + + 'Create a new instance of Outlook + Set oLookApp = New Outlook.Application + + End If + + 'Create a new email + Set oLookItm = oLookApp.CreateItem(olMailItem) + + 'Create a reference to the Excel Table + Set ExcTbl = Sheet1.ListObjects(1) + + With oLookItm + + 'Define some basic info of our email + .To = "xyz@abc.com" + .CC = "xyz@abc.com" + .Subject = "Here are all of my Ranges" + .Body = "Here are all the Ranges from my worksheet." + + 'Display the email + .Display + + 'Get the Active Inspector + Set oLookIns = .GetInspector + + 'Get the document within the inspector + Set oWrdDoc = oLookIns.WordEditor + + 'Copy the table + ExcTbl.Range.Copy + + 'Define the range, insert a blank line, collapse the selection. + Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content + oWrdRng.Collapse Direction:=wdCollapseEnd + + 'Add a new paragragp and then a break + Set oWrdRng = oWdEditor.Paragraphs.Add + oWrdRng.InsertBreak + + 'Paste the object. + oWrdRng.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True + + 'Create a reference to the Word Table + Set oWrdTbl = oWrdDoc.Tables(oWrdDoc.Tables.Count) + + 'Make sure it fits to the email length + oWrdTbl.AllowAutoFit = True + oWrdTbl.AutoFitBehavior (wdAutoFitWindow) + + End With + + +End Sub + + +Sub TableToOutlook_Multi_Sheet() + + 'Declare Outlook Variables + Dim oLookApp As Outlook.Application + Dim oLookItm As Outlook.MailItem + Dim oLookIns As Outlook.Inspector + + 'Declare Word Variables + Dim oWrdDoc As Word.Document + Dim oWrdRng As Word.Range + Dim oWrdTbl As Word.Table + + 'Delcare Excel Variables + Dim ExcTbl As ListObject + Dim WrkSht As Worksheet + + On Error Resume Next + + 'Get the Active instance of Outlook if there is one + Set oLookApp = GetObject(, "Outlook.Application") + + 'If Outlook isn't open then create a new instance of Outlook + If Err.Number = 429 Then + + 'Clear Error + Err.Clear + + 'Create a new instance of Outlook + Set oLookApp = New Outlook.Application + + End If + + 'Create a new email + Set oLookItm = oLookApp.CreateItem(olMailItem) + + With oLookItm + + 'Define some basic info of our email + .To = "xyz@abc.com" + .CC = "xyz@abc.com" + .Subject = "Here are all of my Ranges" + .Body = "Here are all the Ranges from my worksheet." + + 'Display the email + .Display + + 'Get the Active Inspector + Set oLookIns = .GetInspector + + 'Get the document within the inspector + Set oWrdDoc = oLookIns.WordEditor + + For Each ExcTbl In ActiveSheet.ListObjects + + 'Copy the table + ExcTbl.Range.Copy + + 'Define the range, insert a blank line, collapse the selection. + Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content + oWrdRng.Collapse Direction:=wdCollapseEnd + + 'Add a new paragragp and then a break + Set oWrdRng = oWdEditor.Paragraphs.Add + oWrdRng.InsertBreak + + 'Paste the object. + oWrdRng.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True + + 'Create a reference to the Word Table + Set oWrdTbl = oWrdDoc.Tables(oWrdDoc.Tables.Count) + + 'Make sure it fits to the email length + oWrdTbl.AllowAutoFit = True + oWrdTbl.AutoFitBehavior (wdAutoFitWindow) + + Next + + End With + +End Sub +Sub TableToOutlook_Multi_Book() + + 'Declare Outlook Variables + Dim oLookApp As Outlook.Application + Dim oLookItm As Outlook.MailItem + Dim oLookIns As Outlook.Inspector + + 'Declare Word Variables + Dim oWrdDoc As Word.Document + Dim oWrdRng As Word.Range + Dim oWrdTbl As Word.Table + + 'Delcare Excel Variables + Dim ExcTbl As ListObject + Dim WrkSht As Worksheet + + On Error Resume Next + + 'Get the Active instance of Outlook if there is one + Set oLookApp = GetObject(, "Outlook.Application") + + 'If Outlook isn't open then create a new instance of Outlook + If Err.Number = 429 Then + + 'Clear Error + Err.Clear + + 'Create a new instance of Outlook + Set oLookApp = New Outlook.Application + + End If + + 'Create a new email + Set oLookItm = oLookApp.CreateItem(olMailItem) + + With oLookItm + + 'Define some basic info of our email + .To = "xyz@abc.com" + .CC = "xyz@abc.com" + .Subject = "Here are all of my Ranges" + .Body = "Here are all the Ranges from my worksheet." + + 'Display the email + .Display + + 'Get the Active Inspector + Set oLookIns = .GetInspector + + 'Get the document within the inspector + Set oWrdDoc = oLookIns.WordEditor + + For Each WrkSht In ActiveWorkbook.Worksheets + For Each ExcTbl In WrkSht.ListObjects + + 'Copy the table + ExcTbl.Range.Copy + + 'Define the range, insert a blank line, collapse the selection. + Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content + oWrdRng.Collapse Direction:=wdCollapseEnd + + 'Add a new paragragp and then a break + Set oWrdRng = oWdEditor.Paragraphs.Add + oWrdRng.InsertBreak + + 'Paste the object. + oWrdRng.PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True + + 'Create a reference to the Word Table + Set oWrdTbl = oWrdDoc.Tables(oWrdDoc.Tables.Count) + + 'Make sure it fits to the email length + oWrdTbl.AllowAutoFit = True + oWrdTbl.AutoFitBehavior (wdAutoFitWindow) + oWrdTbl.Style = wdStyleTableDarkList + oWrdTbl.BottomPadding = PixelsToPoints(10, True) + oWrdTbl.TopPadding = PixelsToPoints(10, True) + Next + Next + + End With + +End Sub + diff --git a/vba/vba-outlook/Outlook - Appointment Object.bas b/vba/vba-outlook/Outlook - Appointment Object.bas new file mode 100644 index 0000000..0bf0d49 --- /dev/null +++ b/vba/vba-outlook/Outlook - Appointment Object.bas @@ -0,0 +1,86 @@ +Option Explicit + +Sub WorkingWithAppointmentItems() + +'Declare our Variables +Dim oLookApptItem As AppointmentItem +Dim oLookRecipients As Recipients +Dim oLookRecipient As Recipient +Dim oLookMeetingItem As MeetingItem +Dim oLookRecPattern As RecurrencePattern + +'Let's work an email +Set oLookApptItem = Application.CreateItem(olAppointmentItem) + +'Define some attributes about our new meeting, the first beeing the meeting status +oLookApptItem.MeetingStatus = olMeeting + + 'olMeeting 1 The meeting has been scheduled. + 'olMeetingCanceled 5 The scheduled meeting has been cancelled. + 'olMeetingReceived 3 The meeting request has been received. + 'olMeetingReceivedAndCanceled 7 The scheduled meeting has been cancelled but still appears on the user's calendar. + 'olNonMeeting 0 An Appointment item without attendees has been scheduled. This status can be used to + ' set up holidays on a calendar. + +'Give it a subject line +oLookApptItem.Subject = "New Employee Meeting" + +'Give it a location +oLookApptItem.Location = "Conference Room B" + +'Give it a Start Time +oLookApptItem.Start = #1/28/2020 8:00:00 AM# + +'Set the duration +oLookApptItem.Duration = 90 + +'Set the reminder time. +oLookApptItem.ReminderMinutesBeforeStart = 30 + +'Let's add some Recipients, this one will be Required. +Set oLookRecipient = oLookApptItem.Recipients.Add("Bob Gates") + + 'Set the Receipient Type + oLookRecipient.Type = olRequired + +'Let's add some Recipients, this one will be Optional. +Set oLookRecipient = oLookApptItem.Recipients.Add("Bob Gates 2") + + 'Set the Receipient Type + oLookRecipient.Type = olOptional + +'Let's add some Recipients, this one will be Our Resource. +Set oLookRecipient = oLookApptItem.Recipients.Add("Conference Room B") + + 'Set the Receipient Type + oLookRecipient.Type = olResource + +'Let's add some Recipients, this one will be the Organizer. +Set oLookRecipient = oLookApptItem.Recipients.Add("Alex Reed") + + 'Set the Receipient Type + oLookRecipient.Type = olOrganizer + +'Grab the Recurrence Pattern +Set oLookRecPattern = oLookApptItem.GetRecurrencePattern + + 'Let's have it reoccur monthly. + oLookRecPattern.RecurrenceType = olRecursMonthly + + 'Define the start date + oLookRecPattern.PatternStartDate = #1/26/2020# + + 'Define the end date + oLookRecPattern.PatternEndDate = #1/26/2021# + +'Set the Body +oLookApptItem.Body = "Make sure to attend this meeting!" +oLookApptItem.BodyFormat = olFormatHTML + +'Save the Appointment Item. +oLookApptItem.Save + +'Display it. +oLookApptItem.Display + +End Sub \ No newline at end of file diff --git a/vba/outlook-vba/Folder Object.bas b/vba/vba-outlook/Outlook - Folder Object.bas similarity index 97% rename from vba/outlook-vba/Folder Object.bas rename to vba/vba-outlook/Outlook - Folder Object.bas index a9d28d7..ce3da29 100644 --- a/vba/outlook-vba/Folder Object.bas +++ b/vba/vba-outlook/Outlook - Folder Object.bas @@ -1,88 +1,88 @@ -Sub DisplayMail() - -'Declare our Variables -Dim oLookFldrInbox, oLookFldrJunk As Folder -Dim oLookName As NameSpace -Dim oLookTbl As Table -Dim oRow As Row - -'Set the namespace -Set oLookName = Application.GetNamespace("MAPI") - -'Define an outlook folder, in this case the inbox. -Set oLookFldrInbox = oLookName.GetDefaultFolder(olFolderInbox) - -'olFolderCalendar 9 The Calendar folder. -'olFolderConflicts 19 The Conflicts folder (subfolder of the Sync Issues folder). Only available for an Exchange account. -'olFolderContacts 10 The Contacts folder. -'olFolderDeletedItems 3 The Deleted Items folder. -'olFolderDrafts 16 The Drafts folder. -'olFolderInbox 6 The Inbox folder. -'olFolderJournal 11 The Journal folder. -'olFolderJunk 23 The Junk E-Mail folder. -'olFolderLocalFailures 21 The Local Failures folder (subfolder of the Sync Issues folder). Only available for an Exchange account. -'olFolderManagedEmail 29 The top-level folder in the Managed Folders group. For more information on Managed Folders, see the Help in Microsoft Outlook. Only available for an Exchange account. -'olFolderNotes 12 The Notes folder. -'olFolderOutbox 4 The Outbox folder. -'olFolderSentMail 5 The Sent Mail folder. -'olFolderServerFailures 22 The Server Failures folder (subfolder of the Sync Issues folder). Only available for an Exchange account. -'olFolderSuggestedContacts 30 The Suggested Contacts folder. -'olFolderSyncIssues 20 The Sync Issues folder. Only available for an Exchange account. -'olFolderTasks 13 The Tasks folder. -'olFolderToDo 28 The To Do folder. -'olPublicFoldersAllPublicFolders 18 The All Public Folders folder in the Exchange Public Folders store. Only available for an Exchange account. -'olFolderRssFeeds 25 The RSS Feeds folder. - -'Define an outlook folder, in this case the junk. -Set oLookFldrJunk = oLookName.GetDefaultFolder(olFolderJunk) - - 'Grab the path to the folder - Debug.Print oLookFldrJunk.FolderPath - - 'Is webview on? - Debug.Print oLookFldrJunk.WebViewOn - - 'Grab the url - Debug.Print oLookFldrJunk.WebViewURL - - 'How do we show item count? - Debug.Print oLookFldrJunk.ShowItemCount - - 'olNoItemCount 0 No item count displayed. - 'olShowTotalItemCount 2 Shows count of total number of items. - 'olShowUnreadItemCount 1 Shows count of unread items. - - 'We could always change it if we want. - 'oLookFldrJunk.ShowItemCount = olShowTotalItemCount - - 'How many unread emails do we have? - Debug.Print oLookFldrJunk.UnReadItemCount - -'Define an outlook folder, in this case the inbox. -Set oLookFldrInbox = oLookName.GetDefaultFolder(olFolderInbox) - - 'Create table for our Inbox - Set oLookTbl = oLookFldrInbox.GetTable - - 'Let's take a look at all the columns of our table - For Each Column In oLookTbl.Columns - Debug.Print Column.Name - Next - - 'Loop through the table - Do Until (oLookTbl.EndOfTable) - - 'Grab the row - Set oRow = oLookTbl.GetNextRow() - - 'Print the details - Debug.Print oRow("Subject") - Debug.Print oRow("EntryID") - Debug.Print oRow("MessageClass") - - 'Alternative way to grab a value - Debug.Print oRow.GetValues(2) - - Loop - -End Sub +Sub DisplayMail() + +'Declare our Variables +Dim oLookFldrInbox, oLookFldrJunk As Folder +Dim oLookName As NameSpace +Dim oLookTbl As Table +Dim oRow As Row + +'Set the namespace +Set oLookName = Application.GetNamespace("MAPI") + +'Define an outlook folder, in this case the inbox. +Set oLookFldrInbox = oLookName.GetDefaultFolder(olFolderInbox) + +'olFolderCalendar 9 The Calendar folder. +'olFolderConflicts 19 The Conflicts folder (subfolder of the Sync Issues folder). Only available for an Exchange account. +'olFolderContacts 10 The Contacts folder. +'olFolderDeletedItems 3 The Deleted Items folder. +'olFolderDrafts 16 The Drafts folder. +'olFolderInbox 6 The Inbox folder. +'olFolderJournal 11 The Journal folder. +'olFolderJunk 23 The Junk E-Mail folder. +'olFolderLocalFailures 21 The Local Failures folder (subfolder of the Sync Issues folder). Only available for an Exchange account. +'olFolderManagedEmail 29 The top-level folder in the Managed Folders group. For more information on Managed Folders, see the Help in Microsoft Outlook. Only available for an Exchange account. +'olFolderNotes 12 The Notes folder. +'olFolderOutbox 4 The Outbox folder. +'olFolderSentMail 5 The Sent Mail folder. +'olFolderServerFailures 22 The Server Failures folder (subfolder of the Sync Issues folder). Only available for an Exchange account. +'olFolderSuggestedContacts 30 The Suggested Contacts folder. +'olFolderSyncIssues 20 The Sync Issues folder. Only available for an Exchange account. +'olFolderTasks 13 The Tasks folder. +'olFolderToDo 28 The To Do folder. +'olPublicFoldersAllPublicFolders 18 The All Public Folders folder in the Exchange Public Folders store. Only available for an Exchange account. +'olFolderRssFeeds 25 The RSS Feeds folder. + +'Define an outlook folder, in this case the junk. +Set oLookFldrJunk = oLookName.GetDefaultFolder(olFolderJunk) + + 'Grab the path to the folder + Debug.Print oLookFldrJunk.FolderPath + + 'Is webview on? + Debug.Print oLookFldrJunk.WebViewOn + + 'Grab the url + Debug.Print oLookFldrJunk.WebViewURL + + 'How do we show item count? + Debug.Print oLookFldrJunk.ShowItemCount + + 'olNoItemCount 0 No item count displayed. + 'olShowTotalItemCount 2 Shows count of total number of items. + 'olShowUnreadItemCount 1 Shows count of unread items. + + 'We could always change it if we want. + 'oLookFldrJunk.ShowItemCount = olShowTotalItemCount + + 'How many unread emails do we have? + Debug.Print oLookFldrJunk.UnReadItemCount + +'Define an outlook folder, in this case the inbox. +Set oLookFldrInbox = oLookName.GetDefaultFolder(olFolderInbox) + + 'Create table for our Inbox + Set oLookTbl = oLookFldrInbox.GetTable + + 'Let's take a look at all the columns of our table + For Each Column In oLookTbl.Columns + Debug.Print Column.Name + Next + + 'Loop through the table + Do Until (oLookTbl.EndOfTable) + + 'Grab the row + Set oRow = oLookTbl.GetNextRow() + + 'Print the details + Debug.Print oRow("Subject") + Debug.Print oRow("EntryID") + Debug.Print oRow("MessageClass") + + 'Alternative way to grab a value + Debug.Print oRow.GetValues(2) + + Loop + +End Sub diff --git a/vba/outlook-vba/Mailitem Object.bas b/vba/vba-outlook/Outlook - Mailitem Object.bas similarity index 96% rename from vba/outlook-vba/Mailitem Object.bas rename to vba/vba-outlook/Outlook - Mailitem Object.bas index 41dcf89..40c206d 100644 --- a/vba/outlook-vba/Mailitem Object.bas +++ b/vba/vba-outlook/Outlook - Mailitem Object.bas @@ -1,106 +1,106 @@ -Sub DisplayMail() - -'Declare our Variables -Dim oLookItem As Object -Dim oLookMail As MailItem -Dim oLookFldr As Folder -Dim oLookName As NameSpace - -'Set the namespace -Set oLookName = Application.GetNamespace("MAPI") - -'Define the folder that contains my emails. -Set oLookFldr = oLookName.GetDefaultFolder(olFolderInbox) - - 'Display the folder - oLookFldr.Display - -'Loop through all the items in the folder. -For Each itm In oLookFldr.Items - - ' If the item is a mail item - If TypeOf itm Is MailItem Then - Debug.Print itm.Subject - End If - -Next - - -'Let's work an email -Set oLookMail = oLookFldr.Items(5) - - 'Grab the body format - Debug.Print oLookMail.BodyFormat - - 'olFormatHTML 2 HTML format - 'olFormatPlain 1 Plain format - 'olFormatRichText 3 Rich text format - 'olFormatUnspecified 0 Unspecified format - - 'What time was it recieved? - Debug.Print oLookMail.ReceivedTime - - 'Who sent it? - Debug.Print oLookMail.Sender - - 'What was their email address? - Debug.Print oLookMail.SenderEmailAddress - - 'Is it unread? - Debug.Print oLookMail.UnRead - - 'When was it sent? - Debug.Print oLookMail.SentOn - - 'Print the email body text - Debug.Print oLookMail.Body - - - -'Define a Recipient object variable -Dim rec As Recipient - -'Loop through all the recipients on the email -For Each rec In oLookMail.Recipients - - 'Print their email address - Debug.Print rec.Address - - 'Print their name. - Debug.Print rec.Name - - 'Can you send them stuff? - Debug.Print rec.Sendable - -Next - -'Define an attachment object variable -Dim oLookAtt As Attachment - -'Grab an attachment item -Set oLookAtt = oLookMail.Attachments.Item(1) - - 'Grab a file name - Debug.Print oLookAtt.FileName - - 'Check class type - 5 means attachment - Debug.Print oLookAtt.Class - - 'Grab the display name - Debug.Print oLookAtt.DisplayName - - 'Get the size of the file in bytes - Debug.Print oLookAtt.Size - - 'Get the file type - Debug.Print oLookAtt.Type - - 'olByReference 4 This value is no longer supported since Microsoft Outlook 2007. Use olByValue to attach a copy of a file in the file system. - 'olByValue 1 The attachment is a copy of the original file and can be accessed even if the original file is removed. - 'olEmbeddeditem 5 The attachment is an Outlook message format file (.msg) and is a copy of the original message. - 'olOLE 6 The attachment is an OLE document. - -'Display the email -oLookMail.Display - -End Sub +Sub DisplayMail() + +'Declare our Variables +Dim oLookItem As Object +Dim oLookMail As MailItem +Dim oLookFldr As Folder +Dim oLookName As NameSpace + +'Set the namespace +Set oLookName = Application.GetNamespace("MAPI") + +'Define the folder that contains my emails. +Set oLookFldr = oLookName.GetDefaultFolder(olFolderInbox) + + 'Display the folder + oLookFldr.Display + +'Loop through all the items in the folder. +For Each itm In oLookFldr.Items + + ' If the item is a mail item + If TypeOf itm Is MailItem Then + Debug.Print itm.Subject + End If + +Next + + +'Let's work an email +Set oLookMail = oLookFldr.Items(5) + + 'Grab the body format + Debug.Print oLookMail.BodyFormat + + 'olFormatHTML 2 HTML format + 'olFormatPlain 1 Plain format + 'olFormatRichText 3 Rich text format + 'olFormatUnspecified 0 Unspecified format + + 'What time was it recieved? + Debug.Print oLookMail.ReceivedTime + + 'Who sent it? + Debug.Print oLookMail.Sender + + 'What was their email address? + Debug.Print oLookMail.SenderEmailAddress + + 'Is it unread? + Debug.Print oLookMail.UnRead + + 'When was it sent? + Debug.Print oLookMail.SentOn + + 'Print the email body text + Debug.Print oLookMail.Body + + + +'Define a Recipient object variable +Dim rec As Recipient + +'Loop through all the recipients on the email +For Each rec In oLookMail.Recipients + + 'Print their email address + Debug.Print rec.Address + + 'Print their name. + Debug.Print rec.Name + + 'Can you send them stuff? + Debug.Print rec.Sendable + +Next + +'Define an attachment object variable +Dim oLookAtt As Attachment + +'Grab an attachment item +Set oLookAtt = oLookMail.Attachments.Item(1) + + 'Grab a file name + Debug.Print oLookAtt.FileName + + 'Check class type - 5 means attachment + Debug.Print oLookAtt.Class + + 'Grab the display name + Debug.Print oLookAtt.DisplayName + + 'Get the size of the file in bytes + Debug.Print oLookAtt.Size + + 'Get the file type + Debug.Print oLookAtt.Type + + 'olByReference 4 This value is no longer supported since Microsoft Outlook 2007. Use olByValue to attach a copy of a file in the file system. + 'olByValue 1 The attachment is a copy of the original file and can be accessed even if the original file is removed. + 'olEmbeddeditem 5 The attachment is an Outlook message format file (.msg) and is a copy of the original message. + 'olOLE 6 The attachment is an OLE document. + +'Display the email +oLookMail.Display + +End Sub diff --git a/vba/outlook-vba/Namespace Object.bas b/vba/vba-outlook/Outlook - Namespace Object.bas similarity index 96% rename from vba/outlook-vba/Namespace Object.bas rename to vba/vba-outlook/Outlook - Namespace Object.bas index 4ae3266..79fe5c9 100644 --- a/vba/outlook-vba/Namespace Object.bas +++ b/vba/vba-outlook/Outlook - Namespace Object.bas @@ -1,71 +1,71 @@ -Option Explicit - -Sub WorkNamespace() - -'Declare Object Variables -Dim oLookApp As Application -Dim oLookName As NameSpace -Dim oLookAcct As Account -Dim oLookContact As ContactItem - -'Grab the name space object. -Set oLookName = Application.GetNamespace(Type:="MAPI") - - 'Print some details about our namespace - - 'Grab the user. - Debug.Print oLookName.CurrentUser - - 'Grab the profile name - Debug.Print oLookName.CurrentProfileName - - 'Are we offline? - Debug.Print oLookName.Offline - - 'What class object are we? - Debug.Print oLookName.Class '0 means application object - - 'Grab the connection - Debug.Print oLookName.ExchangeConnectionMode - 'olCachedConnectedFull - The account is using cached Exchange mode on a Local Area Network or a fast connection with the Exchange server. - - 'Grab the Servername - Debug.Print oLookName.ExchangeMailboxServerName - - 'Grab the Server Version - Debug.Print oLookName.ExchangeMailboxServerVersion - '... - - 'loop through the folders in the namespace - Dim fldr As Folder - For Each fldr In oLookName.Folders - Debug.Print ("----------------") - Debug.Print fldr.Name - Next - - 'Let's loop through all the accounts in the NameSpace - For Each oLookAcct In oLookName.Accounts - 'Print some details - Debug.Print "-------------" - Debug.Print oLookAcct.UserName - Debug.Print oLookAcct.CurrentUser - Debug.Print oLookAcct.DisplayName - Debug.Print oLookAcct.AccountType '0 means Exchange Account - Next - - 'loop through the categories in the namespace - Dim ctgry As Category - For Each ctgry In oLookName.Categories - Debug.Print ("----------------") - Debug.Print ctgry.Name - Debug.Print ctgry.Color - Next - - 'Grab a contact - Set oLookContact = oLookName.GetDefaultFolder(olFolderContacts).Items("April") - - 'Dial the contact - oLookName.Dial oLookContact - - -End Sub +Option Explicit + +Sub WorkNamespace() + +'Declare Object Variables +Dim oLookApp As Application +Dim oLookName As NameSpace +Dim oLookAcct As Account +Dim oLookContact As ContactItem + +'Grab the name space object. +Set oLookName = Application.GetNamespace(Type:="MAPI") + + 'Print some details about our namespace + + 'Grab the user. + Debug.Print oLookName.CurrentUser + + 'Grab the profile name + Debug.Print oLookName.CurrentProfileName + + 'Are we offline? + Debug.Print oLookName.Offline + + 'What class object are we? + Debug.Print oLookName.Class '0 means application object + + 'Grab the connection + Debug.Print oLookName.ExchangeConnectionMode + 'olCachedConnectedFull - The account is using cached Exchange mode on a Local Area Network or a fast connection with the Exchange server. + + 'Grab the Servername + Debug.Print oLookName.ExchangeMailboxServerName + + 'Grab the Server Version + Debug.Print oLookName.ExchangeMailboxServerVersion + '... + + 'loop through the folders in the namespace + Dim fldr As Folder + For Each fldr In oLookName.Folders + Debug.Print ("----------------") + Debug.Print fldr.Name + Next + + 'Let's loop through all the accounts in the NameSpace + For Each oLookAcct In oLookName.Accounts + 'Print some details + Debug.Print "-------------" + Debug.Print oLookAcct.UserName + Debug.Print oLookAcct.CurrentUser + Debug.Print oLookAcct.DisplayName + Debug.Print oLookAcct.AccountType '0 means Exchange Account + Next + + 'loop through the categories in the namespace + Dim ctgry As Category + For Each ctgry In oLookName.Categories + Debug.Print ("----------------") + Debug.Print ctgry.Name + Debug.Print ctgry.Color + Next + + 'Grab a contact + Set oLookContact = oLookName.GetDefaultFolder(olFolderContacts).Items("April") + + 'Dial the contact + oLookName.Dial oLookContact + + +End Sub diff --git a/vba/outlook-vba/Outlook Table to Excel.bas b/vba/vba-outlook/Outlook to Excel - Tables.bas similarity index 100% rename from vba/outlook-vba/Outlook Table to Excel.bas rename to vba/vba-outlook/Outlook to Excel - Tables.bas