Learn how to a build a cloud-first strategyRegister Now

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

Repeating the script

dear sir /  madam ,

I have this script, that is doing the following :-

1- Create Folder under the Contact Folder in the Personal Folder for MS-OUTLOOK 2003.
2- Copy the Contacts information from Shared folder located on One PC .

we deployed this  script,and we do not have any Problems at all for Part A .

but the Problem is in Part ( B ).


 PART (  A )  this is the script:-
============================================================================

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

-------------------------------------------------------------------------------------------------------------------


PART B ):-

Now, we are hiring every month 20 Persons.

so we need to update all the users as well with the same configurations for them - E-mails, Numbers, & So on ...

so , i change the first line in script, so instead of creating the folder, it will check only the folder which has been created by the script in PART A and start doing its work.

but when i run this script , i found that, its display this error message :-

Line: 12
Char :46
Error: Syntax Error
Code : 800A03EA
source : Microsoft VB Script Compilation error

so where could be the Problem ?
 
here is the script :- ( PART B ).
----------------------------------------------------------------------------------------------------------------------------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders.Add("SEMSEM", 10)
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.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.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.")
0
rolamohammed
Asked:
rolamohammed
  • 14
  • 13
1 Solution
 
bruintjeCommented:
Hi rolamohammed,

The vbscript error is a syntax error but from your description i think it is trying to create the folder again while it already exists

This script will run on a machine that has the folder SEMSEM already under the contacts folder in Outlook

in Part B run the script like
---------
Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders("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.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.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.")
---------

hope this helps a bit
bruintje
0
 
rolamohammedAuthor Commented:
Hi Brian ,

Thanks for your Help.

but finally i know i am talking with MAN Now.

But let me tell you something, you DID very Good thing for me and you Helped me toooooooo much, and you deserve from me more & more & More ,

Thanks for your Always Help .

i will test & i will come back to you man , with the results.
0
 
bruintjeCommented:
ok, just post back here if things work out or not :-)
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
rolamohammedAuthor Commented:
Yes, thanks , its working .

What will happen if i need to do this Idea - if you can do it for me it will only help me.

As long as i am going to deploy to all the Users in My Company , i am thinking to Add Only one extra-feature that need your Help .

as you Know, i have 200 User now, and all of them are not in one office.

so i am going to deploy this script by using E-mail or at least by using Active Directory 2003.

So my idea is, when ever the script is download or exceuted on the PC, i want this script - Either Script A or B, to Take the Computer Name & Computer IP Address & Send an E-mail Directly to this E-mail ( XYZ@mydomain.com ).

so i am thinking to see this on the E-mail:-

Dear All,

Computer ( .............................. ), IP-Address (......................), has been updated by this script and no Problems was found at all .

Please Note that, All the Users Configured to Use POP3 & SMTP.
the POP3 is ( 64.202.165.92 ) , the SMTP ( 64.202.165.58 ).

so when ever the script run on this PC, the Script completely will gather information regarding ( Computer Name - IP Address ) , and will send this E-mail directly to this Address ( xyz@my domain.com ), and say to him this things:-
Dear All,

Computer ( .............................. ), IP-Address (......................), has been updated by this script and no Problems was found at all .

-----------------------

can you please help me brian and try to help me in this if you can ?

i know its extra things, no more , and i am working with your perfect solution, but i want only to help my self, so please if you can help me.

0
 
rolamohammedAuthor Commented:

Hi Brian ,

Tell me Please, if you can do this favour for me or it will not be possible to implement .

i know i asked you soooooooooo much , and really i am wondering if you could help me to do that for me.

I know its extra and i need only to test it man , so Please help me to do it .

BTW, all the Users are configured to use POP3 & SMTP, we do not have any internal Mail server here, so i need to implement it, Please help me to do it ,.

many many thanks for your Help and your way. many thanks for you .
0
 
bruintjeCommented:
ok what you can do is this, you need to paste PART A or PART B in this script at the top so it will first update the contacts and then send a report through mail as per your description

'------------------
'Paste here your PART A or PART B script
'------------------

'------------------
Dim objNet, strComputerName

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

'------------------
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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 = "XYZ@mydomain.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")
ns.logon "","",true,false
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
newMail.Send

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

Brian ,

Many thanks for your help.

But i get confused .

so as what i understood the Script A will have 2 things or will have 2 script inside it. so if i want to deploy the first script which is in Part A, it will be like that :-

( Please Note that, I just cut & Past the Script which is did the E-mail, so please check and correct me ).

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

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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

'------------------
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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 = "XYZ@mydomain.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")
ns.logon "","",true,false
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
newMail.Send

Set ol = Nothing: Set ns = Nothing: Set newMail = Nothing

0
 
rolamohammedAuthor Commented:
Dear Brian,

I have 2 question, please try to correct me .


Q 1:- which Idea is correct ?  First Idea , or second Idea ?

The First Idea :-
 i will have 2 scripts , the first one will be the Script in Part A, or Part B.
then we will have the second script which is sending the mail and the report to us .

the Second Idea :-

I will have one script, will do the 2 things. Part A or Part B & then send the E-mail.

Please correct me, which Idea is correct ?

------------------------------------------------------------------------------------------------------------------------

Q2 :-
in case of the First Idea is correct, is the script for Sending the IP & Computer name & E-mail wrote correct or Not ?


Dim objNet, strComputerName

Set objNet = CreateObject("WScript.NetWork")
strComputerName = objNet.ComputerName
Set objNet = Nothing
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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 = "XYZ@mydomain.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")
ns.logon "","",true,false
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
newMail.Send

Set ol = Nothing: Set ns = Nothing: Set newMail = Nothing



0
 
bruintjeCommented:
Q2. the script was written for PART B

but you can write one script that will do PART A and B at once and send you the result through email, if that is what you want just comment it will do this

1. check if the folder SEMSEM exists
    if yes then load the contacts
    if no then create the folder first and create the contacts
2. get the computer name and ip address
3. send and email with results
0
 
rolamohammedAuthor Commented:

Yes, Brian

i have just come noe to my office, i was in the hospital all the day yesterday.

that is why i could not at all check it.

so soory for that , i had a seriouse case .


, this is what I  need .

For the Script A, i need to do Both Things, Put the Contacts and send E_mails in the Same Time.

I will highly appritiated if you wrote for me the Whole script which is Part A , that doing both, because i do not know how to make.

i need only script A, then Script B .

No need to have one script to do Part A and Part B.

I need from you if you do not mind, to write  script in Part A which is doing it and send an E-mail, also Script in Part B.

-------------------------------------------------------

script A:-
.......................................
including the E-mail Part.

script B :-

including E-mail Part.

0
 
bruintjeCommented:
well i hope things will be better for you

in the meantime you already had PART A here

'------------------
'this script will
'1. add a new folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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

'------------------
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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 = "XYZ@mydomain.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")
ns.logon "","",true,false
Set newMail = ol.CreateItem(olMailItem)
newMail.Subject = MessageSubject
newMail.Body = MessageBody & vbCrLf
newMail.Send

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

thanks for Help

but this is Script Part A . which is including E-mail Part or what ?

is this script Part A ? if Not can you Added Please with E-mail Part ?

thanks for you .
0
 
bruintjeCommented:
yes email is included its this

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

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

ToAddress = "XYZ@domain.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
'------------------

so the complete script is

'------------------
'this script will
'1. add a new folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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

'------------------
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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 = "XYZ@domain.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
'------------------

i tested the mail part forgot to set a to address but it should work if you change the xyz@domain.com address
0
 
rolamohammedAuthor Commented:
Here is the Script for Add Folder name ( SEMSEM ), and to take the information from Excel sheet, and to send an e-mail.

i got this error message :-

Line : 25
Char : 8
error : Expected end of statement.
Code : 800A0401
Source :.....

here is the script.
Please help me ,

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

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

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

ToAddress = "XYZ@domain.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
'------------------

so the complete script is

'------------------
'this script will
'1. add a new folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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

'------------------
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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
'------------------







0
 
bruintjeCommented:
'------------------
'this script will
'1. add a new folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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

'------------------
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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
'------------------
0
 
bruintjeCommented:
is all you need
0
 
rolamohammedAuthor Commented:
what do you mean ?

i put this script by make copy & past, and i got this error message :-


Line : 25
Char : 8
error : Expected end of statement.
Code : 800A0401
Source :.....


please help
0
 
bruintjeCommented:
sorry used your email in my test
0
 
bruintjeCommented:
you can try this one there was dot somewhere in the script

'------------------
'this script will
'1. add a new folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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
'------------------
0
 
rolamohammedAuthor Commented:
agian , i just a copy the script and Past it, and i got this error message :-

Line : 46
Char : 76
error : Expected end of statement.
Code : 800A0401
Source :.....


===================================================
here is the script :-

====================================================
Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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

'------------------
'GetIPaddr.vbs - Check the IP address you are currently
'connected to the Internet with (or LAN IP).
'© 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
0
 
bruintjeCommented:
take this script, that was tested and send you the mail

'------------------
'this script will
'1. add a new folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

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

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
'------------------
0
 
rolamohammedAuthor Commented:
thank you very much,

please i want the script for update, so it doesnot need to create the folder . do you remmber the script in part B , which is only add new contacts in Folder " SEMSEM " which is already created before.

Please, its very good , you are more than perfect brian .

0
 
bruintjeCommented:
this is the PART B script not creating the folder just using it if it exists

'------------------
'this script will
'1. add a new folder
'2. upload the contacts
'3. and send the mail
'------------------

Dim objNS, oOlFolder, objOutlook, objWorkbook, x, objContact
Dim myItems

Const olFolderContacts = 10

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set oOlFolder = objNS.GetDefaultFolder(olFolderContacts).Folders("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.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.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

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
'------------------
0
 
rolamohammedAuthor Commented:

brian ,

while i am deploying it , i found that :-


there is a POP message apper to the User which is say:-

A Program is trying to Automatically Send - E-mail on your Behalf. do you want to allow this ?

this message i do not want it to appear for the user at all , and start send automatically , can you please tell me on that ?

0
 
bruintjeCommented:
using outlook you can't its a security feature, the only way around that is installing a third party program that clicks the button or install a dll from the vbsendmail packacge to send the mail without any notice to the user
0
 
rolamohammedAuthor Commented:

thanks Brian ,

For all of your Helps & all of your really assistant to me.

i want to say only one word, i know its not enough for you , but really , you are the only one who helped me and give me extra helping in this issue and assisting me .

many many thanks for your help man , and best of luck for you .

if i have the chance i will hire you as consultant for our company , i will email you offline .

0
 
bruintjeCommented:
thanks Rola, all the best with the project and with the company :-)
we will see what the future brings
0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

  • 14
  • 13
Tackle projects and never again get stuck behind a technical roadblock.
Join Now