[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 172
  • Last Modified:

Create Specifc Distribution List under Specific Folder .


Dear All,

refrence to my request on this URL :-
http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21844678.html

Q2:- is there anyway to write a script ( I will consider it Script E ), to create Specific Distribution List ( called - Finance ), in Specific Folder ( SEMSEM ) which has been created by using Script A or B, and it takes all the information or its Members from the same file which is located on ("\\Ho-it-htaguiam\test2\egypt-2.xls") but all the information will be taken from Sheet (2) , not sheet (1) as we wrote in Script A & B.
---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
0
rolamohammed
Asked:
rolamohammed
  • 12
  • 9
1 Solution
 
bruintjeCommented:
Hi rolamohammed,

if its working this is your Script E

'------------------
' Script E
'------------------
'this script will
'1. add a new folder called Finance under the SEMSEM contact folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems, strFirstName, strLastName, strFileAs

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders("SEMSEM").Folders.Add("Finance")
Set myItems = oOlFolder.Items

Set objexcel = CreateObject("Excel.Application")
Set objWorkbook = objexcel.Workbooks.Open("\\Ho-it-htaguiam\test2\egypt-2.xls")

x = 1

Do Until objWorkbook.Sheets(2).Cells(x, 1).Value = ""

     Set objContact = myItems.Add("IPM.Contact.CTXContacts")
          objContact.FullName = objWorkbook.Sheets(1).Cells(x, 1).Value
          objContact.CompanyName = objWorkbook.Sheets(1).Cells(x, 2).Value
          objContact.Email1Address = objWorkbook.Sheets(1).Cells(x, 3).Value
          objContact.BusinessTelephoneNumber = objWorkbook.Sheets(1).Cells(x, 4).Value
          objContact.HomeTelephoneNumber = objWorkbook.Sheets(1).Cells(x, 5).Value
          objContact.BusinessFaxNumber = objWorkbook.Sheets(1).Cells(x, 6).Value
          objContact.MobileTelephoneNumber = objWorkbook.Sheets(1).Cells(x, 7).Value
          objContact.BusinessAddress = objWorkbook.Sheets(1).Cells(x, 8).Value
          objContact.Department = objWorkbook.Sheets(1).Cells(x, 9).Value
          objContact.OfficeLocation = objWorkbook.Sheets(1).Cells(x, 10).Value
          objContact.ManagerName = objWorkbook.Sheets(1).Cells(x, 11).Value
          objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value
          objContact.Save

       'add this part to save as
       strFirstName = .FirstName
          strLastName = .LastName
       strFileAs = strFirstName & ", " & strLastName  
          objContact.FileAs = strFileAs

    x = x + 1
   
Loop

Set myItems = Nothing
Set oOlFolder = Nothing
Set objNS = Nothing
Set objOutlook = Nothing
Set objContact = Nothing

objWorkbook.Close False
objexcel.Quit
Set objWorkbook = Nothing
Set objexcel = Nothing

WScript.Echo( "Say Thanks to  us " & vbCrLf & "We are here to serve you.")

Dim objNet, strComputerName, strDomainName

Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
strDomainName = objNet.UserDomain
Set objNet = Nothing
'------------------

'------------------
' ©Bill James - bill@billsway.com
' rev 15 Jan 2002
' Now works with Windows NT, 2K, XP

Dim IP_Address : IP_Address = GetIP()

Function GetIP()
  Dim ws : Set ws = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
  Dim ThisLine, IP
  If ws.Environment("SYSTEM")("OS") = "" Then
    ws.run "winipcfg /batch " & TmpFile, 0, True
  Else
    ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
  End If
  With fso.GetFile(TmpFile).OpenAsTextStream
    Do While NOT .AtEndOfStream
      ThisLine = .ReadLine
      If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
    Loop
    .Close
  End With
  'WinXP (NT? 2K?) leaves a carriage return at the end of line
  If IP <> "" Then
    If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
  End If
  GetIP = IP
  fso.GetFile(TmpFile).Delete  
  Set fso = Nothing
  Set ws = Nothing
End Function
'------------------

' now we have both computername and ip address
' time to send te email

'------------------
' source: http://www.rgagnon.com/wshdetails/wsh-0018.html

Dim ToAddress
Dim MessageSubject
Dim MessageBody
Dim ol, ns, newMail

ToAddress = "boma_15@hotmail.com"
MessageSubject = "Outlook Contact Update"
MessageBody = "Dear All," & vbCrLf & vbCrLf & _
           "Computer " & strComputerName & strDomainName & ", IP-Address " & IP_Address & ", has been updated by this script and no problems found at all ."

Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
newMail.To = ToAddress
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
newMail.Send

Set ol = Nothing: Set ns = Nothing: Set newMail = Nothing
'------------------

hope this helps a bit
bruintje
0
 
rolamohammedAuthor Commented:

i will test it now, and i will reply to you .
0
 
bruintjeCommented:
ok thanks, i'l be away for a few hours but will check back in later
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
rolamohammedAuthor Commented:
OK
0
 
rolamohammedAuthor Commented:

Yes, Brian .

its working but there is some error .

first it create folder called finance .

But what i want is :-

1- it will create a group ( New Distribution List ) , under the Folder which has been created before by using Script A, and then it will take all the Users who are in the same folder which is :-

("\\Ho-it-htaguiam\test2\egypt-2.xls")

but it will take all the Information, from Sheet 2 , instead of Sheet 1

Please Help me to do that .

what i see from the script is , Create Folder NAME FINANCE , and there is no any Distrbution list has been created and
no users has been added to the Group it self.

please urgent help me .

0
 
rolamohammedAuthor Commented:
brian

is there any news about it , please help me and do not leave me , i trust you man .
0
 
rolamohammedAuthor Commented:
please , brian help me .
0
 
bruintjeCommented:
i'm back here now, its saturday here much like your friday :)

ok i misunderstood and created a folder with the contacts but you want a distribution list with the contacts from sheet 2

be right back
0
 
bruintjeCommented:
how does sheet 2 look like? can you give a sample of a row? adding members to a distribution list is easy [mail entry only] or difficult [contact entry]
0
 
rolamohammedAuthor Commented:
Thanks , for your always Help , i am so soory , that i forget your Weekend .

Take your Time , its friday for you .

anyway, take it easy , i need it to be on the same file and the same sheet, please discard what i said .

make it normal.

its here CAIRO , 9:06 AM here . Morning 14-MAY-2006
0
 
rolamohammedAuthor Commented:
Ya Brian ,

What i need is :-

1- No need to create any Folder, we will assume that the Folder " SEMSEM " Has been Created in the Script A.
2- IT will make only one Group " Distribution List " Called " FInance Group ".
3- Take only the Name & E-mails from Excel sheet , ( sheet 1 ) , and it will Put the User Name & E-mail Address.


Thanks For your Help man.



0
 
rolamohammedAuthor Commented:

Yes brian ,

please once you have time , try to find this for me , please brian.
0
 
bruintjeCommented:
Hi Rola,

This is script E creating a distribution list "Finance" based on the info from the excel sheet, just see if it works and if you need some other parts added to it like sending a confirmation mail

'------------------
' SCRIPT E
'------------------
'this script will
'1. add a new distribution list called Finance
'2. use the mail addressses from the SEMSEM contacts
'------------------
 
Dim objNS, oOlFolder As MAPIFolder, objOutlook, objExcel, objWorkbook, x, objContact
Dim myItems, strFirstName, strLastName, strFileAs
Dim myDistList, myRecipients, myTempItem, strfullName, strEmail1Address
 
Const olFolderContacts = 10
Const olDistributionListItem = 69
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set myDistList = objOutlook.CreateItem(olDistributionListItem)
myDistList.DLName = "Finance"

Set myTempItem = objOutlook.CreateItem(olMailItem)
Set myRecipients = myTempItem.Recipients
 
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("\\Ho-it-htaguiam\test2\egypt-2.xls")

x = 1
 
Do Until objWorkbook.Sheets(1).Cells(x, 1).Value = ""
 
     strfullName = objWorkbook.Sheets(1).Cells(x, 1).Value
     strEmail1Address = objWorkbook.Sheets(1).Cells(x, 3).Value
     myRecipients.Add strfullName & "<" & strEmail1Address & ">"
     x = x + 1
   
Loop
 
myDistList.AddMembers myRecipients
myDistList.Save

Set myTempItem = Nothing
Set myRecipients = Nothing
Set myDistList = Nothing
Set myItems = Nothing
Set oOlFolder = Nothing
Set objNS = Nothing
Set objOutlook = Nothing
 
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
'------------------
0
 
rolamohammedAuthor Commented:

Yes Brian , good morning.

i need please the confirmation Part of the E-mail .


i return back to the work, its toooo cloudy here in Egypt. Local Time in Jeddah is 9:05 AM Morning
0
 
bruintjeCommented:
its 08.13 AM here in Amstedam, sunny and cool

this is the script containing a confirmation email

'------------------
' SCRIPT E
'------------------
'this script will
'1. add a new distribution list called Finance
'2. use the mail addressses from the SEMSEM contacts
'------------------
 
Dim objNS, oOlFolder As MAPIFolder, objOutlook, objExcel, objWorkbook, x, objContact
Dim myItems, strFirstName, strLastName, strFileAs
Dim myDistList, myRecipients, myTempItem, strfullName, strEmail1Address
 
Const olFolderContacts = 10
Const olDistributionListItem = 69
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set myDistList = objOutlook.CreateItem(olDistributionListItem)
myDistList.DLName = "Finance"

Set myTempItem = objOutlook.CreateItem(olMailItem)
Set myRecipients = myTempItem.Recipients
 
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("\\Ho-it-htaguiam\test2\egypt-2.xls")

x = 1
 
Do Until objWorkbook.Sheets(1).Cells(x, 1).Value = ""
 
     strfullName = objWorkbook.Sheets(1).Cells(x, 1).Value
     strEmail1Address = objWorkbook.Sheets(1).Cells(x, 3).Value
     myRecipients.Add strfullName & "<" & strEmail1Address & ">"
     x = x + 1
   
Loop
 
myDistList.AddMembers myRecipients
myDistList.Save

Set myTempItem = Nothing
Set myRecipients = Nothing
Set myDistList = Nothing
Set myItems = Nothing
Set oOlFolder = Nothing
Set objNS = Nothing
Set objOutlook = Nothing
 
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
'------------------

WScript.Echo( "Say Thanks to  us " & vbCrLf & "We are here to serve you.")

Dim objNet, strComputerName, strDomainName

Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
strDomainName = objNet.UserDomain
Set objNet = Nothing
'------------------

'------------------
' ©Bill James - bill@billsway.com
' rev 15 Jan 2002
' Now works with Windows NT, 2K, XP

Dim IP_Address : IP_Address = GetIP()

Function GetIP()
  Dim ws : Set ws = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
  Dim ThisLine, IP
  If ws.Environment("SYSTEM")("OS") = "" Then
    ws.run "winipcfg /batch " & TmpFile, 0, True
  Else
    ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
  End If
  With fso.GetFile(TmpFile).OpenAsTextStream
    Do While NOT .AtEndOfStream
      ThisLine = .ReadLine
      If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
    Loop
    .Close
  End With
  'WinXP (NT? 2K?) leaves a carriage return at the end of line
  If IP <> "" Then
    If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
  End If
  GetIP = IP
  fso.GetFile(TmpFile).Delete  
  Set fso = Nothing
  Set ws = Nothing
End Function
'------------------

' now we have both computername and ip address
' time to send te email

'------------------
' source: http://www.rgagnon.com/wshdetails/wsh-0018.html

Dim ToAddress
Dim MessageSubject
Dim MessageBody
Dim ol, ns, newMail

ToAddress = "boma_15@hotmail.com"
MessageSubject = "Outlook Contact Update"
MessageBody = "Dear All," & vbCrLf & vbCrLf & _
           "Computer " & strComputerName & strDomainName & ", IP-Address " & IP_Address & ", has been updated by this script a new distributionlist called Finance was added and no problems found at all ."

Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
newMail.To = ToAddress
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
newMail.Send

Set ol = Nothing: Set ns = Nothing: Set newMail = Nothing
'------------------
0
 
rolamohammedAuthor Commented:
brian ,

thanks for your help,

i know i made a lot of confuse for you ,

please , i discover some issue with Script A , while i am deploying it for my CEO , Please have a look to it , its urgent for me , we have duplicated itmes , please help me , here is the location .

http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21850507.html
0
 
rolamohammedAuthor Commented:
brian , let us return back to this , but please let us work with the same things which we did beofore.

0
 
bruintjeCommented:
hi Rola,

not sure if you're around but this script only needed to be tested?

brian
0
 
rolamohammedAuthor Commented:
yes brian, i am still in the work,

please provide me with the script , so i can start .
0
 
bruintjeCommented:
you are making very long days

' SCRIPT E
'------------------
'this script will
'1. add a new distribution list called Finance
'2. use the mail addressses from the SEMSEM contacts
'------------------
 
Dim objNS, oOlFolder As MAPIFolder, objOutlook, objExcel, objWorkbook, x, objContact
Dim myItems, strFirstName, strLastName, strFileAs
Dim myDistList, myRecipients, myTempItem, strfullName, strEmail1Address
 
Const olFolderContacts = 10
Const olDistributionListItem = 69
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set myDistList = objOutlook.CreateItem(olDistributionListItem)
myDistList.DLName = "Finance"

Set myTempItem = objOutlook.CreateItem(olMailItem)
Set myRecipients = myTempItem.Recipients
 
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("\\Ho-it-htaguiam\test2\egypt-2.xls")

x = 1
 
Do Until objWorkbook.Sheets(1).Cells(x, 1).Value = ""
 
     strfullName = objWorkbook.Sheets(1).Cells(x, 1).Value
     strEmail1Address = objWorkbook.Sheets(1).Cells(x, 3).Value
     myRecipients.Add strfullName & "<" & strEmail1Address & ">"
     x = x + 1
   
Loop
 
myDistList.AddMembers myRecipients
myDistList.Save

Set myTempItem = Nothing
Set myRecipients = Nothing
Set myDistList = Nothing
Set myItems = Nothing
Set oOlFolder = Nothing
Set objNS = Nothing
Set objOutlook = Nothing
 
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
'------------------

WScript.Echo( "Say Thanks to  us " & vbCrLf & "We are here to serve you.")

Dim objNet, strComputerName, strDomainName

Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
strDomainName = objNet.UserDomain
Set objNet = Nothing
'------------------

'------------------
' ©Bill James - bill@billsway.com
' rev 15 Jan 2002
' Now works with Windows NT, 2K, XP

Dim IP_Address : IP_Address = GetIP()

Function GetIP()
  Dim ws : Set ws = CreateObject("WScript.Shell")
  Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
  Dim TmpFile : TmpFile = fso.GetSpecialFolder(2) & "/ip.txt"
  Dim ThisLine, IP
  If ws.Environment("SYSTEM")("OS") = "" Then
    ws.run "winipcfg /batch " & TmpFile, 0, True
  Else
    ws.run "%comspec% /c ipconfig > " & TmpFile, 0, True
  End If
  With fso.GetFile(TmpFile).OpenAsTextStream
    Do While NOT .AtEndOfStream
      ThisLine = .ReadLine
      If InStr(ThisLine, "Address") <> 0 Then IP = Mid(ThisLine, InStr(ThisLine, ":") + 2)
    Loop
    .Close
  End With
  'WinXP (NT? 2K?) leaves a carriage return at the end of line
  If IP <> "" Then
    If Asc(Right(IP, 1)) = 13 Then IP = Left(IP, Len(IP) - 1)
  End If
  GetIP = IP
  fso.GetFile(TmpFile).Delete  
  Set fso = Nothing
  Set ws = Nothing
End Function
'------------------

' now we have both computername and ip address
' time to send te email

'------------------
' source: http://www.rgagnon.com/wshdetails/wsh-0018.html

Dim ToAddress
Dim MessageSubject
Dim MessageBody
Dim ol, ns, newMail

ToAddress = "boma_15@hotmail.com"
MessageSubject = "Outlook Contact Update"
MessageBody = "Dear All," & vbCrLf & vbCrLf & _
           "Computer " & strComputerName & strDomainName & ", IP-Address " & IP_Address & ", has been updated by this script a new distributionlist called Finance was added and no problems found at all ."

Set ol = WScript.CreateObject("Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
Set newMail = ol.CreateItem(olMailItem)
newMail.To = ToAddress
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
newMail.Send

Set ol = Nothing: Set ns = Nothing: Set newMail = Nothing
'------------------
0
 
bruintjeCommented:
the last script is answering the question
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 12
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now