Create Specifc Distribution List under Specific Folder .

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

i will test it now, and i will reply to you .

ok thanks, i'l be away for a few hours but will check back in later

OK

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 .

brian

is there any news about it , please help me and do not leave me , i trust you man .

please , brian help me .

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

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]

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

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.

Yes brian ,

please once you have time , try to find this for me , please brian.

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
'------------------

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

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
'------------------

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 .

https://www.experts-exchange.com/questions/21850507/For-Mr-Brian-Urgent-Regarding-Script-A-B.html

brian , let us return back to this , but please let us work with the same things which we did beofore.

hi Rola,

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

brian

yes brian, i am still in the work,

please provide me with the script , so i can start .

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
'------------------