Deleted specific Itmes from one contact in specific folder

Hi rolamohammed,

Hi rolamohammed,

do you have a file where the contact items to delete are listed? i mean how must the script determine which contact items form which contact to delete?

bruintje

No, what i mean is ,

the script take the information from Shared Folder over Network on Excel Sheet and then put in the user side .

did you understand me .

brain

is there any news about

Brian,

Good Morning , is there any News regarding it .

Hi Rola

if i understand this correctly the script needs to read from an excel file the updated items for the contacts in the SEMSEM folder

does the excel sheet look the same as the original SCRIPT A excel sheet1?
and how do you mark a contact for deletion or change of the items only?

Brian

Hi Brian ,

this is ROLA agian from Egypt.

Can you imagin, i am still in the work alone with my self , testing and deploying your scripts .

its here now 22:15 PM Local time in Egypt, and this night i think its very very very very Hot  & cloudy , and the weather is bad.

anyway,

YES, you understand me correctly .


 but frankly speaking, provide me with the best way from your point of view , i need to consult you in this , please help me if was my idea is wrong , and give me your recommendation or the bestway from your point of view brian .

its too hot man here, i will have drink now .\

well then out weather is a bit better, cool and a few clouds its 21.30 here so we're only 1 hour seperated

about the script

yes i would use the same format for updates or deletions it makes reusing the script easier, only one small addition for 2 columns at the end one for marking a deletion and one for marking an update

if the script is looping through the contacts it will look at the deletion column and check if it is marked if it is clear then it will check the update column to see if the contact must be updated

if this is ok with you i'll write the script based on SCRIPT A

This is is SCRIPT D, i use the same worksheet layout as in SCRIPT A with 2 new columns

column 13 has a 1 or nothing to mark a contact for deletion
column 14 has a 1 or nothing to mark a contact for update

'------------------
' SCRIPT D
'------------------
'this script will
'1. lookup contacts in the SEMSEM folder
'2. if founzd
'3. and send the mail
'------------------
 
Dim objNS, oOlFolder As MAPIFolder, objOutlook, objExcel, objWorkbook, x, objContact As Outlook.ContactItem
 
Const olFolderContacts = 10
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders("SEMSEM")
 
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 = ""

  Set objContact = oOlFolder.Items.Find("[FullName] = "" & objWorkbook.Sheets(1).Cells(x, 1).Value & """)
  ' first check the delete column assuming column 13 in the worksheet
  If objWorkbook.Sheets(1).Cells(x, 13).Value = 1 Then
    objContact.Delete
  End If
  ' check the update column assuming column 14 in the worksheet
  If objWorkbook.Sheets(1).Cells(x, 14).Value = 1 Then
    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
  End If
  x = x + 1
Loop
 
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

Dim IP_Address: IP_Address = 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
'------------------
 
' 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
'------------------

Hi brian ,

this is Rola from Egypt again .

Actually , i could not understand what do you mean by this :-

 " yes i would use the same format for updates or deletions it makes reusing the script easier, only one small addition for 2 columns at the end one for marking a deletion and one for marking an update

if the script is looping through the contacts it will look at the deletion column and check if it is marked if it is clear then it will check the update column to see if the contact must be updated "

Can you please expalin to me, because i could not understand you brian .

Rola- Egypt

2:00 AM Local Time , Egypt

Goodmorning Rola,

When you have contacts (1 or more) use the same setup for a sheet as the original egypt-2.xls.

But insert 2 new columns at the end besides the objWorkbook.Sheets(1).Cells(x, 12).Value, contact body which is now Column 12.

Column 13 is for deletions

Column 14 is for updates

The script will check column 13 and 14 what to do with the contact

Brian

Yes Brian ,

so if we have Egypt-2.xls file, i will add only 2 columns only .
so what should i wrote in these cloums , exactly ?  can you expalin to me more

if a contact must be deleted then fill a 1 in column 13 else leave it empty
if a contact must be updated then fill a 1 in column 14 else leave it empty

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