I have a unique problem. We have a Distribution List with our team members in IT on it. Every morning, we send out an email to the DL. But a specific set of people don't want to receive this email. is there a way to still have them on the DL but not receive a specific email?
Thanks!
No, there is no trivial way for setting that out of the box. You can retrieve the distribution list programmatically, extract the required recipients from it and send an email to them added to the BCC field.
You may find the following articles helpful:
How To: Create and send an Outlook message programmatically
How To: Fill TO,CC and BCC fields in Outlook programmatically
Use the DistListItem.GetMember method which returns a Recipient object representing a member in a distribution list. The following VBA sample code shows how to deal with distribution lists and their members:
Sub DisplayYourDLNames()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myDistList As Outlook.DistListItem
Dim myFolderItems As Outlook.Items
Dim x As Integer
Dim y As Integer
Dim iCount As Integer
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)
Set myFolderItems = myFolder.Items
iCount = myFolderItems.Count
For x = 1 To iCount
If TypeName(myFolderItems.Item(x)) = "DistListItem" Then
Set myDistList = myFolderItems.Item(x)
For y = 1 To myDistList.MemberCount
If myDistList.GetMember(y).Name = myNameSpace.CurrentUser.Name Then
MsgBox "Your are a member of " & myDistList.DLName
End If
Next y
End If
Next x
End Sub
Related
I've seen answers to questions similar to this one, but I haven't been able to find anything that addresses this exact situation.
Goal: Populate a list box and/or a worksheet with the output of a HypQueryMembers function. For example, I would like to get a list of the descendants of account 10100 without having to perform an ad hoc query and zoom in. I know how to get the return code, e.g. 0 if successful, but I want the actual output. I found some code that populated a list box, but I haven't been able to get it to work for me. I receive the error "Could not set the List property. Invalid property array index." My code follows:
Sub TestQueryMbrs()
Dim X As Integer
Dim arrAccounts
X = HypQueryMembers(Empty, "10100", HYP_DESCENDANTS, Empty, Empty, Empty, Empty, arrAccounts)
If X <> 0 Then
MsgBox "Unable to populate members." & vbCr & vbCr & "Error: " & X, vbCritical + vbOKOnly
Else
UserForm2.ListBox1.List = arrAccounts
UserForm2.Show
End If
End Sub
Any idea what I'm doing wrong? Also, I would like to accomplish the same thing, but populate a worksheet rather than a list box. But one step at a time!
Thanks!
Is 10100 the genuine name of the field? I suspect by you calling it account that 10100 should be replaced by Account instead as that parameter seems to be limited to the field name rather than an individual member. However, I have yet to determine how to get descendents of a particular account/cost centre so your way may be the correct way to do this.
I'd suggest trying that change to just "Account" though and then try adding as variant to Dim arrAccounts and then deleting Dim arrAccounts altogether if that doesn't work.
You may also not be able to populate the listbox before Userform2 is shown? You could wrap application.screenupdating =FALSE then TRUE around the Userform2 changes so the user doesn't see the list box being populated if there is a lag.
I had the same issue today and ran across this post - I realize it's years old...
Oracle's documentation on this function is a bit confusing... at least the example they used at the bottom of the page: https://docs.oracle.com/cd/E72988_01/DGSMV/ch12s15.html
For example, you need to enter the integer value for HYP_DESCENDANTS, which is 2 instead of the text shown in your code.
The following is a good snippet of code to verify your array:
Declare PtrSafe Function HypQueryMembers Lib "HsAddin" (ByVal vtSheetName As Variant, ByVal vtMemberName As Variant, ByVal vtPredicate As Variant, ByVal vtOption As Variant, ByVal vtDimensionName As Variant, ByVal vtInput1 As Variant, ByVal vtInput2 As Variant, ByRef vtMemberArray As Variant) As Long
Sub Example_HypQueryMembers()
sts = HypQueryMembers("INSERT WORKSHEET NAME HERE", "INSERT SMARTVIEW MEMBER HERE", 1, Empty, Empty, Empty, Empty, vArray)
If IsArray(vArray) Then
cbItems = UBound(vArray) + 1
MsgBox ("Number of elements = " + Str(cbItems))
For i = 0 To UBound(vArray)
MsgBox ("Member = " + vArray(i))
Next
Else
MsgBox ("Return Value = " + Str(vArray))
End If
End Sub
I know that it isn't possible to generate a control array at runtime.
However, is it possible to have several control arrays that I sub in at different points, referred to via a variable? IE
dim CArray() as controls
CArray = Labels
Foo(CArray)
CArray = OtherLabels
Foo(CArray)
My attempts to do this so far lead to a compile-time error, as it won't allow the control array actually on the form to be referred to without using a method or element. It gives the error:
Arugment not optional
You could use an object:
Private Sub Form_Load()
Dim CArray As Object
Set CArray = Labels
Foo CArray
End Sub
Sub Foo(CtrlArray As Object)
Dim i as Long
For i = 0 To CtrlArray.ubound
CtrlArray(i).Caption = Rnd
Next
End Sub
So I've seen a couple posts on this topic, but can't seem to find a way to get it to work. My goal is to create a Stacked Column Graph using VBA with the following characteristics:
Each column is based on data from a row (e.g. E6:P6, E7:P7, etc.).
Each "stack section" is each column in that row (located at E4:P4)
X Axes Labels are located in column A (e.g. A6, A7, etc.)
Y Axes Labels dynamic based on data (non specific).
Chart Title (which is the easy part - I got this).
Granted I also need the legend which shows the color key used by item 2.
This graph is one of three needed per report across 30+ reports that I generated via VBA from a raw data file. The last step to the reports is to make these graphs.
I am able to get stacked graph created, but the biggest problem is that as the data ranges above show, there are gaps in the data. This causes split sections in the graph as well as additional labels that I don't want. Essentially I don't know how to format the graph, and reading the Object Window that pops up from typing "ActiveChart." has only gotten me this far. If I know various formatting commands (alas I'm new to VBA with Excel), I can replicate it across all the charts that I need.
Dim data As Range
Set data = Range("A4:P12")
With Charts.Add
.ChartType = xlColumnStacked
.SetSourceData Source:=data, PlotBy:=xlColumns
.HasTitle = True
.ChartTitle.Text = "Weekly Report"
.Location Where:=xlLocationAsObject, Name:="Sheet1"
End With
Example of what I can make:
Output Graph
Side note about the blank data: The leftmost blank spot where a bar would be is the empty column D. Also I need to be able to edit the axes labels.
How about something like this:
Public Sub MakeGraph()
Dim ws As Excel.Worksheet
Dim data As Excel.Range
Dim x_axis_labels As Excel.Range
Dim series_names As Excel.Range
Dim sh As Excel.Shape
Dim ch As Excel.Chart
Dim I As Long
Set ws = Sheet1
Set data = ws.Range("E4:P12") ' Assumes the data are in E4:P12
Set x_axis_labels = ws.Range("A4:A12") ' Assumes the labels are in A4:A12
Set series_names = ws.Range("E2:P2") ' Assumes the labels are in E2:P2
Set sh = ws.Shapes.AddChart
Set ch = sh.Chart
With ch
.ChartType = xlColumnStacked
.SetSourceData Source:=data, PlotBy:=xlColumns
.HasTitle = True
.ChartTitle.Text = "Weekly Report"
.Axes(xlCategory, xlPrimary).CategoryNames = x_axis_labels
' Add series names
For I = 1 To .SeriesCollection.Count
.SeriesCollection(I).Name = series_names.Cells(1, I)
Next I
End With
Set ch = Nothing
Set sh = Nothing
Set series_names = Nothing
Set x_axis_labels = Nothing
Set data = Nothing
Set ws = Nothing
End Sub
Hope that helps
I take it your missing data would be a column in the range E6:P14? (I'm using E6:P14 because that's what you said first. Your code and #xidgel's later said E4:P12.)
Try this:
Sub MakeChart()
Dim rCats As Range
Dim rNames As Range
Dim rData As Range
Dim iCol As Long
Set rCats = ActiveSheet.Range("A6:A14")
Set rNames = ActiveSheet.Range("E4:P4")
Set rData = ActiveSheet.Range("E6:P14")
With ActiveSheet.Shapes.AddChart(xlColumnStacked).Chart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
For iCol = 1 To rData.Columns.Count
If WorksheetFunction.Count(rData.Columns(iCol)) > 0 Then
' it's not blank
With .SeriesCollection.NewSeries
.Values = rData.Columns(iCol)
.XValues = rCats
.Name = "=" & rNames.Cells(1, iCol).Address(, , , True)
End With
End If
Next
End With
End Sub
I wrote this code that seeks for a particular string in all messages within all mailboxes (average of 100 mesages per mailbox (10 mailboxes total)).
The thing is... the code works but it is too damn slow, even freezes Outlook.
Is there something I can do to make it faster?
Sub InboxSeeker(Word As String)
Dim u As Integer, AddressArr() As String, Users() As String, Element As Variant, Label As Control
GetOutlook
AddressArr = QryLoop_Specific("Company", "Address", "Users", "Team", "Samples", "Address")
For Each Element In AddressArr
Set lFolder = GetFolder(Element)
Set lItems = GetFolder(Element).Items
For Each lMsg In lItems
If InStr(1, lMsg.Body, Word, vbTextCompare) > 0 Or InStr(1, lMsg.Subject, Word, vbTextCompare) > 0 Then
DoEvents
ReDim Preserve Users(u)
Users(u) = QrySingleResult("Company", "FullName", "Users", "Address", Element)
u = u + 1
End If
Next lMsg
Next Element
I am not fully sure why you need DoEvents at each iterations, but you might need it in your GUI, otherwise just do it once at the end.
I believe that ReDim of the array all the time is not very efficient. Why not using a Collection?
Collections vs Array
You could change your code to include
Dim Users as new Collection
...
Users.Add QrySingleResult("Company", "FullName", "Users", "Address", Element)
For Each Element In AddressArr
Set lFolder = GetFolder(Element)
Set lItems = GetFolder(Element).Items
For Each lMsg In lItems
Instead of iterating over all folders and items in Outlook you need to use the Find/FindNext or Restrict methods of the Items class to find Outlook items that matches your conditions.
Also I'd suggest using the AdvancedSearch method of the Namespace class which performs a search based on a specified DAV Searching and Locating (DASL) search string.
Use Items.Find/FindNext
set item = lItems.Find("#SQL=(""urn:schemas:httpmail:textdescription"" LIKE '%something%') OR (""http://schemas.microsoft.com/mapi/proptag/0x0E1D001F"" LIKE '%something%') ")
while Not (item is Nothong)
...
set Item = lItems.FindNext
wend
I have an array set up
Dim managerList(1 To 50, 1 To 100) As String
what I am trying to do, is set the first, second, and third elements in the row
managerList(index,1) = tempManagerName
managerList(index,2) = tempIdeaNumber
managerList(index,3) = 1
But get an error when I try to do that saying that the object variable is not set. I maintain index as an integer, and the value corresponds to a single manager, but I can't seem to manually set the third element. The first and second elements set correctly.
On the flip side, I have the following code that will allow for the element to be set,
For x=1 To 50
If StrConv(tempManagerName,3) = managerList(x,1) Then
found = x
For y=3 to 100
If managerList(x,y) = "" Then
managerList(x,y) = tempIdeaNumber
Exit for
End If
Next
Exit For
End If
Next
It spins through the array (laterally) trying to find an empty element. Ideally I would like to set the index of the element the y variable is on into the 3rd element in the row, to keep a count of how many ideas are on the row.
What is the best way to keep a count like this? Any idea why I am getting a Object variable not set error when I try to manually set the element?
object variable not set means that you are trying to call methods or access properties on an un-initialized object. I don't see anything like that in the code snippets you have published, are you sure the error occurs in those lines?
A good way to pin-point errors is to include the module and line number in the error message. Add this around your subroutine to get a more detailed message:
Sub Initialize
On Error Goto errorthrower
//
// your code goes here...
//
Exit sub
ErrorThrower:
Error Err, Str$(Err) & " " & Error & Chr(13) + "Module: " & Cstr( Getthreadinfo(1) ) & ", Line: " & Cstr( Erl )
End sub
(I originally found this on Ferdy Christants blog)
It's not quite clear what problem you are trying to resolve here, but it looks like you have 1..50 "managers" that can have 1..100 "ideas" ? I'd make a class for managers instead:
Class manager
Private managername As String
Private ideas(1 To 100) As String
Sub new(managername As String)
Me.managername=managername
End Sub
// whatever methods you need....
End Class
Then, I'd keep track of them with a list of these objects:
Dim managerlist List As manager
Dim key As String
key = Strconv(tempmanagername,3)
if not iselement(managerlist(key)) then
set managerlist(key) = new manager(key)
end if
Dim currentmanager As manager
Set currentmanager = managerlist(key)
This is only an example to get you started, you will have to adapt this to solve your actual problem.