For Mr. Brian - Urgent - Regarding Script A & B

Hi Rola,
could you send a small sample egypt-2.xls with 1 or 2 contact lines so i can test?

you do have my mail address,

i'll post it on the web so anyone else looking into this can help too

Brian

ok,
i send you a complete list of our contacts , in excel sheet , please keep it with you

i only received the pdf file with the list as you have it now no excel sheet received.

but from the pdf it looks like there was an error in running another script on the same pc

1. lets start with a clean contact folder
2. so if there is a SEMSEM folder delete it
3. run SCRIPT A to create the folder and add the contacts

now at this point do you see the double entries?

let me know

yes brian , i have sent this excel sheet to you , in your e-mail ,

i delete the file " SEMSEM " , from PC & i run the script , and i found the same results , as duplicated .

i want to applogize from sending an E-mail to you without your permission , please accept my aplogize for that .

please , and once it will solve i will return back to the other scripts .

now i did receive the excel file, if you say its confidential
i'll not post the actual file just a dummy here > http://www.traktiq.net/ee_temp/E-mails-3.xls

No, its not confedential ,

you can check, and i need your help, its the FIRE POINT FOR ME , ITS INFRONT OF MY CEO , THE BIG MANAGEMENT .

PLEASE HELP .

yes i understand try this script which i tested with your file, be sure to delete the SEMSEM folder first

'------------------
' Script A
'------------------
'this script will
'1. add the SEMSEM contact folder
'2. upload the contacts
'3. and send the mail
'------------------

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

Const olFolderContacts = 10

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

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

x = 2

Do Until objWorkbook.Sheets(1).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

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

    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 & ".com" & ", 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
'------------------

if the order of firstname, lastname is still wrong then this script should have the correct order it uses the fullname to determine the correct names i didn't realize that

'------------------
' Script A
'------------------
'this script will
'1. add the SEMSEM contact folder
'2. upload the contacts
'3. and send the mail
'------------------

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

Const olFolderContacts = 10

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

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

x = 2

Do Until objWorkbook.Sheets(1).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

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

    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 & ".com" & ", 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
'------------------

brian ,

the first script , is doing the same error as befor , its duplicated exactly as the PDF file .

and its sorting it completely as A,B,C,

for the second script , its not sorting, and its also duplicated as well.

its still duplicated brian as per the PDF file which i sent you in E-mail,

Please Help me brain .

ok, i've tested with the file you send me

what happens if you work with that file yourself? it begins to look like your egypt-2 files contains more then one line per contact because i tried it with E-Mails-2.xnls without a problem

so, what do you think the Problem come from where ,

i will send you the original file for SAUDI BRANCH, Please test it and check it alon , its confedential and has all the contacts .

please update me man.

i send you a jpg of what happened in my outlook with your original contact file

brain ,

yes, this is what i have exactly.

But Now , i will tell you what exactly i am doing .

1- first , i am using MS-OUTLOOK 2003 as POP3.
2- right click on " SEMSEM " Folder and then choose " Propertities " - its in Pic no ( 2 ).
3- choose OUTLOOK Address Book and select show this folder - its in PIC no ( 3 ) , in your E-mails.
4- click on Mail. pic no ( 4 ).
5- now i want to compose a message and send it to some people who is located in " SEMSEM " Folder, so i click on " NEW " as Pic no  ( 5 ).
6- now on PIC 5 & 6 , you will find that , i highlited address which is duplicated .


please check your e-mail , and you will know where is the duplication.

the duplication happen when i choose New, and choose from the " SEMSEM " folder , the contacts which i need to send them the E-mails, i found that its still duplicated , as one for SMTP & one for FAX.

please help me brian , i am in critical situation as you know.

if we could not do any thing, to solve it, please let us back to the old one which is only send an E-mail confirm , and its not sorting or its not even display any thing as A, B , C .

please check your e-mail now .

so from the last PIC which is NO 6, the user will get confused as you know , where he should choose , or what he should choose ?

please help brian as much as you can .

i've exchange server here so i can't view the folder as addressbook,

i'll be home in 20 minutes where i can test this

until i'm there here you have the old script back or use the one in the first question that does not store on firstname lastname

>>>>please let us back to the old one which is only send an E-mail confirm

'------------------
' Script A
'------------------
'this script will
'1. add the SEMSEM contact folder
'2. upload the contacts
'3. and send the mail
'------------------

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

Const olFolderContacts = 10

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

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

x = 2

Do Until objWorkbook.Sheets(1).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

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

    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 & ".com" & ", 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
'------------------

brian

i am like loosing every t hiing .,

even this script display the same error , please help me brian .

i now see what you mean i'm looking into this, even with the original didn't went that far into the script so not sure if it already was showing this behaviour

brian , i am loosing every thing man , what is going on , i do not know ?? please help me . brian .

ok i now understand this is normal behaviour and it was already this way in the previous scripts

to solve this we have 2 options
1. store the fax addresses in a seperate folder and not in this SEMSEM but maybe SEMSEM-FaxList
2. store the fax number in another phone field so its not visible in the addressbook

Please Help me and do not leave me , i will lose every thing , if you could not help me , please please please , please , its with the CEO him self not with any one else brain , please .

ok i this script puts the faxnumber in another field just to have your addressbook in good shape

test it first on your own machine

'------------------
' Script A
'------------------
'this script will
'1. add the SEMSEM contact folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact As Outlook.ContactItem
Dim myItems, strFirstName, strLastName, strFileAs, objexcel

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders.Add("SEMSEM")
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(1).Cells(x, 1).Value = ""

    Set objContact = myItems.Add("IPM.Contact.CTXContacts")
    objContact.OtherAddress = objWorkbook.Sheets(1).Cells(x, 6).Value
    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
   
    'add this part to save as
    strFirstName = objContact.LastName
    strLastName = objContact.FirstName
    strFileAs = strFirstName & ", " & strLastName
    objContact.FileAs = strFileAs
   
    objContact.Save

    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 & ".com" & ", 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
'------------------

the script will put the faxnumber in the other address field

let me know how it goes, i'm around

OK, brian , let us try the second option which is

2. store the fax number in another phone field so its not visible in the addressbook

because we need the user only to see the E-mails , no more,

and if he wants to see the fax or something, he will double click on the user contacts and see the information completely .

TAKE CARE FROM THIS :-

 when the user want to see the FAX , or something, he will click on the folder SEMSEM , and then he will see all the Users details in front of him as per the Pic you sent me, then he will choose the user and then double click on him and see the Data.

but when he is trying to compose the message , he will only have or see the e-mails.

please let us work on this , i know its hard , but i know you have big heart for me brian .

:)
i posted the script already test it out on your own machine first and let me know how it goes, the cause of the problem is found now we have to work around it

Very Good, i will test the script which you put ,

i know , without you , i am NOTHING .

well that should change after this, you better learn to write them yourself thats much saver for you :)

brain ,

it gives this error message :-

line : 10
Char : 62
Error : Excepected end of statement.
Code : 800A0401


please help

sorry item  of testing left, use

'------------------
' Script A
'------------------
'this script will
'1. add 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, objexcel

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders.Add("SEMSEM")
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(1).Cells(x, 1).Value = ""

    Set objContact = myItems.Add("IPM.Contact.CTXContacts")
    objContact.OtherAddress = objWorkbook.Sheets(1).Cells(x, 6).Value
    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
   
    'add this part to save as
    strFirstName = objContact.LastName
    strLastName = objContact.FirstName
    strFileAs = strFirstName & ", " & strLastName
    objContact.FileAs = strFileAs
   
    objContact.Save

    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 & ".com" & ", 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
'------------------

yes, but let me finish from the scripts which we need , to take the bouns first, and i promise you i will learn .

but i hope at least , i will have the bouns, not fired from the company .

yes brian , its working but there is something :-

1- first , when i try to compose the message, i found that all the Address is sorted completely according to the first name .

2- but when we open or click the folder " SEMSEM ", we discover that , its not sorted .

3- Please , we need to display the Address.

4- here is the E-mail which i recevied :-

Dear All,

Computer HO-IT-M-TANTAWI.HO-IT-M-TANTAWI.com, IP-Address 192.168.1.63, has been updated by this script and no problems found at all .


please help me to make it like " ho-it-m-tantawi.kabholding.com ", because this is the CEO full computer name .


i hope we will do the same steps , in Script B, so i can move directly to Other scripts to finish from it .

please brian do not leave me .

is that your pic

http://www.freefin.com/mulder.htm

please confirm.

:) nope

ohhhhhhhh :((

please help me on this :-

1- first , when i try to compose the message, i found that all the Address is sorted completely according to the first name .

2- but when we open or click the folder " SEMSEM ", we discover that , its not sorted .

3- Please , we need to display the Address.

4- here is the E-mail which i recevied :-

Dear All,

Computer HO-IT-M-TANTAWI.HO-IT-M-TANTAWI.com, IP-Address 192.168.1.63, has been updated by this script and no problems found at all .


please help me to make it like " ho-it-m-tantawi.kabholding.com ", because this is the CEO full computer name .


i hope we will do the same steps , in Script B, so i can move directly to Other scripts to finish from it .

please brian do not leave me .

ok i've changed a few things and i think the 2,3,4 are solved just test it first

'------------------
' Script A
'------------------
'this script will
'1. add 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, objexcel, strFullName, arrName

Const olFolderContacts = 10

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

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

x = 2

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

    Set objContact = myItems.Add("IPM.Contact.CTXContacts")
    objContact.OtherAddress = objWorkbook.Sheets(1).Cells(x, 6).Value
    strFullName = 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.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
   
    'add this part to save as
    arrName = Split(strFullName, ".")
    If UBound(arrName) = 0 Then
      arrName = Split(strFullName, " ")
      If UBound(arrName) = 0 Then
        objContact.FullName = arrName(0)
      Else
        objContact.FullName = arrName(1) & " " & arrName(0)
      End If
    Else
      objContact.FullName = arrName(1) & " " & arrName(0)
    End If
    strFirstName = objContact.FirstName
    strLastName = objContact.LastName
    strFileAs = strFirstName & ", " & strLastName
    objContact.FileAs = strFileAs
    objContact.Save

    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, objShell

Set objShell = WScript.CreateObject("Wscript.Shell")
Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
strDomainName = objShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultDomainName")
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 & ".com" & ", 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
'------------------

brian ,
:-

no, nothing has been appear for that:-


1- first , when i try to compose the message, i found that all the Address is sorted completely according to the first name .

2- but when we open or click the folder " SEMSEM ", we discover that , its not sorted .

3- Please , we need to display the Address.

4- here is the E-mail which i recevied :-

Dear All,

Computer HO-IT-M-TANTAWI.HO-IT-M-TANTAWI.com, IP-Address 192.168.1.63, has been updated by this script and no problems found at all .


please help me to make it like " ho-it-m-tantawi.kabholding.com ", because this is the CEO full computer name .

strange at least the name thing in the folder should be different i tested it here

the domainname is coming from the registry

sorry maybe i switched the first and lastname bit difficult for me to see what is a first or last name because i'm not used to them

offffffffffffffffffffffff

we arrive , no not we , but me.

i arrived to the very critical area, the registry .

brian , can i send you my CV to find work for me ?

:)),,,, hahhahahahahha

i am very cute girl, crazy, i am 170 CM , white , and no more , crazy because of scripts :)) , :))

so, what will happen ??? how we are going to do ? also nothing has been done from 1, 2, 3, ?

'------------------
' Script A
'------------------
'this script will
'1. add 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, objexcel, strFullName, arrName

Const olFolderContacts = 10

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

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

x = 2

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

    Set objContact = myItems.Add("IPM.Contact.CTXContacts")
    objContact.OtherAddress = objWorkbook.Sheets(1).Cells(x, 6).Value
    strFullName = 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.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
   
    'add this part to save as
    arrName = Split(strFullName, ".")
    If UBound(arrName) = 0 Then
      arrName = Split(strFullName, " ")
      If UBound(arrName) = 0 Then
        objContact.FullName = arrName(0)
      Else
        objContact.FullName = arrName(0) & " " & arrName(1)
      End If
    Else
      objContact.FullName = arrName(0) & " " & arrName(1)
    End If
    strFirstName = objContact.FirstName
    strLastName = objContact.LastName
    strFileAs = strFirstName & ", " & strLastName
    objContact.FileAs = strFileAs
    objContact.Save

    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, objShell

Set objShell = CreateObject("Wscript.Shell")
Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
strDomainName = objShell.RegRead("HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultDomainName")
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 & ".com" & ", 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
'------------------

brian ,

for :-


1- first , when i try to compose the message, i found that all the Address is sorted completely according to the first name .

2- but when we open or click the folder " SEMSEM ", we discover that , its not sorted .
-----------------------------------------------------------------------------------------------------------------------------------------

No, 1 & 2 has been solved .
------------------------------------------------------------------------------------------------------------------------------------------

for No 3 which is  " we need to display the Address. " , its not solved , and its display the FAX Number in the feild of Address.

for No 4, let us only make simple, by only take the Computer Name and the IP address, ok, no need at all for the Full Computer name like ( HO-IT-M-TANTAWI.MYDOMAIN.COM ), but we will make like that only ( HO-IT-M-TANTAWI ) + IP-Address  has been updated.


so, what i need from you is , please, we need to upload the Address and put it in the folder SEMSEM, so when he wants to know the Address of this user, he will only double click on the folder " SEMSEM ", and then choose the user, and then double click on him , and then he will find the Address for Him. but put the fax any where else .

thanks for your help.

i do not understand point 3 display the address? i've put the fax in the otheraddress field to circumvent the fax problem with the addreslist we had earlier

this script will solve point 4

'------------------
' Script A
'------------------
'this script will
'1. add 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, objexcel, strFullName, arrName

Const olFolderContacts = 10

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

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

x = 2

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

    Set objContact = myItems.Add("IPM.Contact.CTXContacts")
    objContact.OtherAddress = objWorkbook.Sheets(1).Cells(x, 6).Value
    strFullName = 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.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
   
    'add this part to save as
    arrName = Split(strFullName, ".")
    If UBound(arrName) = 0 Then
      arrName = Split(strFullName, " ")
      If UBound(arrName) = 0 Then
        objContact.FullName = arrName(0)
      Else
        objContact.FullName = arrName(0) & " " & arrName(1)
      End If
    Else
      objContact.FullName = arrName(0) & " " & arrName(1)
    End If
    strFirstName = objContact.FirstName
    strLastName = objContact.LastName
    strFileAs = strFirstName & ", " & strLastName
    objContact.FileAs = strFileAs
    objContact.Save

    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, objShell

Set objShell = CreateObject("Wscript.Shell")
Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
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 & ", 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
'------------------

brian ,  good .

but i discover that :-

1- its not talking  or its not going down to finish , because it left some names also, so i change the value of x from 2 to be  X = 1

but i want the script to start work untill it will not find any thing at all in the excel sheet , because, it stop while there is alos around 20 names did not take them at all.


also, i need from you only to let the script to take the complete Address which i put in the excel sheet and it should be displayed when the user double click on folder " semsem " then he will find the user, and then he will find his address .

we need it - the address -.

also you did very good thing that you enable me to write any thing in the feild notes, so i can put his TITLE or something.

so please let us do this things and we are about to solve it man ,

thanks .


the first name in the excel sheet which is in A1, in sheet 1 , and its ignoring him completely .
2- second , its not going after

brian ,

discard the last thing from me , its my mistke , but see this idea :-


this is what i am talking about it , which is very very good :-

objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value


so i am thinking  in this idea :-

1- i will delete the fax from the feild of Address.
2- i will upload the address.
3- in feild of contact.body , i will add the cell no 12 & 13 and 13 will be the fax and it will but it on it , so what do you think ?

objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value
objContact.Body = objWorkbook.Sheets(1).Cells(x, 13).Value

can it work , or not ?

ok for your last comment 1,2 and 3 replace the contact part with this

    Set objContact = myItems.Add("IPM.Contact.CTXContacts")
    strFullName = 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.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 & vbcrlf & objWorkbook.Sheets(1).Cells(x, 12).Value

brian ,

is this is the script :-

===============================

'------------------
' Script A
'------------------
'this script will
'1. add 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, objexcel, strFullName, arrName

Const olFolderContacts = 10

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

Set objexcel = CreateObject("Excel.Application")
Set objWorkbook = objexcel.Workbooks.Open("\\172.16.1.135\test2\egypt-6.xls")
'Set objWorkbook = objexcel.Workbooks.Open("g:\e-mails.xls")

x = 1

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

   Set objContact = myItems.Add("IPM.Contact.CTXContacts")
    strFullName = 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.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 & vbcrlf & objWorkbook.Sheets(1).Cells(x, 12).Value

   
    'add this part to save as
    arrName = Split(strFullName, ".")
    If UBound(arrName) = 0 Then
      arrName = Split(strFullName, " ")
      If UBound(arrName) = 0 Then
        objContact.FullName = arrName(0)
      Else
        objContact.FullName = arrName(0) & " " & arrName(1)
      End If
    Else
      objContact.FullName = arrName(0) & " " & arrName(1)
    End If
    strFirstName = objContact.FirstName
    strLastName = objContact.LastName
    strFileAs = strFirstName & ", " & strLastName
    objContact.FileAs = strFileAs
    objContact.Save

    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, objShell

Set objShell = CreateObject("Wscript.Shell")
Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
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 & ", 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
'------------------

but as i believe , i have to change this sentence :-

objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value & vbcrlf & objWorkbook.Sheets(1).Cells(x, 12).Value

to be :-

objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value & vbcrlf & objWorkbook.Sheets(1).Cells(x, 13).Value

becasue , i am going to write it in other cell. is that correct ?

is the address will appear man , or not ?

i've to leave for 3 hours
its 1945PM here so i'll be back later, this is script A we worked on you can make script B yourself the only difference is one line

this is script A adding a folder
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders.Add("SEMSEM")

and this is the same line in script B
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders("SEMSEM")

so to get script B from script A

save script A as script B and change the line

sorry saw your last comment later

yes you have to change that line as you said, that is correct !!

brain ,

its working , but i found that , it cant take any thing from :-

objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value

i mean we used to write any thing in the body like his JOB TITLE and so on, and display it on the body , but its not appear.

the Address is appear and not Problems.

Just only i need to add his job title which has been used to do with this :-
objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value and to add the fax in the same way.

please advice me .

so only for script b, i have to change the line for

Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders("SEMSEM")


and the other is the same , is that clear ?

yes that is correct the rest is the same for script B

for your contactbody question

in the file i got from you column 12 is only the job title

objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value

should contain the job title

if you have other columns 13 or 14 then that info needs to be added like

objContact.Body = objWorkbook.Sheets(1).Cells(x, 12).Value & vbcrlf & _
     objWorkbook.Sheets(1).Cells(x, 13).Value & vbcrlf & _
     objWorkbook.Sheets(1).Cells(x, 14).Value & vbcrlf

when i looked at SEMSEM as detailed address cards it contained the job title in the body

btu as said i'm off for a few hours will be back later

Brain ,

CAN I KISS YOU ,  or NOT ???

please , CAN I SEND YOU KISS MAN .

CAN I SEND YOU KISS ?

i hope i will make the SCRIPT B , and move directly to the other scripts ( C,D,E,F ).

KISS FROM EGYPT TO THE LEADER HERE WHO IS YOU .

:) well thats too much

i hope the script is working now, and hope that you learn something from this
maybe not a nice way of learning but that happens :)

if you need more help on script a or b let me know

yes , its working , both script A, & B.

i know i made you tired to much, but really if you were in front of me i will kiss you .

you deserve it.

i will go now to the other scripts, and i hope once you take a break, we will close this chapter first , and i will inform you once i get the bouns .

you deserve 80 % of this bouns , really you deserve.

i will check now the other scripts as well