ASP and OUTLOOK 3

[CooterBrown]

I am trying to connect to Outlook through asp for our intranet site. The purpose is to capture the names of all users in outlook so I can build a drop box in a form in our intranet. I don't want to build a database and duplicate data. Does anyone know how to do this with CDO or any other method? Let me know please.

Thanks in advance,
CMSSJ@gpmlife.com

 

[Trope]

Email me for the code, I do not want to post it, as it can be very easily modified to be a virus.

 

[CooterBrown]

trope,

Cannot find your e-mail address in your profile to get this code from you. Could you e-mail it to cmssj@gpmlife.com

thanks

 

[shomai]

sent the code to me too ..shomai@edsamail.com.ph thanks .

 

[gsc1ugs]

And me... gsc1ugs@yahoo.co.uk gsc1ugs
"Cant see wood for tree's...!"

 

[Trope]

Wow, had several responsed to this immediately. Tell ya what, I will post the code tonight when I get off work. Who am I to deprive people of code cuz it could be modified into a virus, right?

See all of you around 6:30pm Central.

 

[CooterBrown]

Well that's up to you. Anything you send to me stays with me. As far as I'm concerned the less viruses the better.

 

[Trope]

Okay, here ya go. Use wisely!

Set Outlook=CreateObject("Outlook.Application&quot
If Outlook="Outlook" Then
'Outlook is on this machine
Set Mapi=Outlook.GetNameSpace("MAPI&quot
Set Lists=Mapi.AddressLists
For Each ListIndex in Lists
If ListIndex.AddressEntries.Count<>0 THEN
ContactCount=ListIndex.AddressEntries.Count
For Count=1 to ContactCount
Set Contact=ListIndex.AddressEntries(Count)
emailaddresses=emailaddresses&Contact.Address&vbcrlf
Next
End IF
NEXT
MsgBox(emailaddresses)
END IF

 

[Trope]

Okay here's one more snippet of code. This one allows you to search your contacts.

Dim objOutlook
Dim objNameSpace
Dim objFolder

Dim strInput
Dim strMsg
Dim strAddress
Dim cItem
Dim strOutput

Const olFolderContacts = 10
Const cTextCaseInsensitive = 1

strMsg = &quot;Enter a search string.&quot; & vbcrlf & &quot;(Example: Dan)&quot;
strInput = InputBox(strMsg,&quot;Search For ...&quot;,&quot;Dan&quot

Set objOutlook = CreateObject(&quot;Outlook.application&quot
Set objNameSpace = objOutlook.GetNameSpace(&quot;MAPI&quot
Set objFolder = objNameSpace.GetDefaultFolder(olFolderContacts)

For Each cItem in objFolder.Items
If Instr(1,cItem.FullName,strInput,cTextCaseInsensitive) > 0 Then
strOutput = String(45,&quot;~&quot & vbCrLf
strOutput = strOutput & &quot;Full Name:&quot; & vbTab & cItem.FullName & vbCrLf
strOutput = strOutput & &quot;EMail Address:&quot; & vbTab & cItem.EMail1Address & vbCrLf
strOutput = strOutput & &quot;Phone Number:&quot; & vbTab & cItem.PrimaryTelephoneNumber & vbCrLf
strOutput = strOutput & &quot;Busniess Address:&quot; & vbTab & cItem.BusinessAddressStreet & vbCrLf

strAddress = vbTab & vbTab & cItem.BusinessAddressCity & &quot; &quot;
strAddress = strAddress & cItem.BusinessAddressState & &quot; &quot;
strAddress = strAddress & cItem.BusinessAddressPostalCode

strOutput = strOutput & strAddress & vbCrLf
strOutput = strOutput & String(45,&quot;~&quot & vbCrLf

Msgbox strOutput, , cItem.Subject
End If
Next

If strOutput = &quot;&quot; Then
Msgbox &quot;No contacts match search requirements.&quot;, vbInformation,&quot;Contact Search&quot;
End If



' **** Clean up
'
Set objFolder = Nothing
Set objNameSpace = Nothing
set objOutlook = Nothing

 

[Trope]

Last one, promise. You guys should be getting the hang of this by now. Since I dug all this stuff I just figured I'd post it. What the heck. This one displays any unread messages. Can be very useful in an intranet environment:

'----------------------------------------------------------
Dim objOutlook
Dim objNameSpace
Dim objFolder
Dim CurrentItem
Dim strOutput

Const olFolderInbox = 6

Set objOutlook = CreateObject(&quot;Outlook.application&quot
Set objNameSpace = objOutlook.GetNameSpace(&quot;MAPI&quot
Set objFolder = objNameSpace.GetDefaultFolder(olFolderInbox)

For Each CurrentItem in objFolder.Items
If CurrentItem.Unread then
strOutput = &quot;Sender: &quot; & CurrentItem.SenderName & vbCrLf
strOutput = strOutput & &quot;Total Attachments = &quot; & CurrentItem.Attachments.Count & vbCrLf

' Since the MsgBox wraps at 76 Characters, add a divder of that length
strOutput = strOutput & String(76,&quot;~&quot & vbCrLf
strOutput = strOutput & CurrentItem.Body
Msgbox strOutput, , CurrentItem.Subject
End If
Next

If strOutput = &quot;&quot; Then
Msgbox &quot;No Unread Messages&quot;, vbInformation,&quot;The following mail is unread&quot;
End If



' **** Clean up
'
Set objFolder = Nothing
Set objNameSpace = Nothing
set objOutlook = Nothing
'----------------------------------------------------------

 

[RussOSU]

Wow thanks for everything above. You posted this just in time cause I was about to post something asking for the contact list information. I have one last thing that I am not sure if it is possible or not and that is to create meeting requests through asp. The webpage I am creating is to schedule job requests and I want to enter into a calendar when the job is due. BTW I am a very very very beginner when it comes to programming so how ever far you can break it down or comment it would be GREATLY appreciated. Hopefully I can start to disect some of these codes and teach myself enough so I don't have to keep bugging others.

Thanks
Russ

 

[CooterBrown]

Microsoft VBScript runtime error '800a01ad'

ActiveX component can't create object: 'Outlook.Application'


this is the error message I'm getting. Any ideas?

 

[gsc1ugs]

no gsc1ugs
&quot;Cant see wood for tree's...!&quot;

 

[Trope]

This error typically occurs when Outlook is not installed on the machine that the code is running on.

To further test, save the file with a .vbs extension and run it from your desktop. If you are still getting that error, for some reason your Outlook is not being detected by the script...

 

[CooterBrown]

I am getting a different error when I run it from my desktop.

Script: C:\winnt\profiles\cmssj\desktop\trail2.vbs
Line: 1
Char: 1
Error: Expected statement
Code: 800A0400
Source: Microsoft VBScript compilation error.

 

[Trope]

Hmmm... Try this, save as .vbs

This will loop through all your contacts and shoot them an email...

'

On Error Resume Next


Set A01 = CreateObject( &quot;Scripting.FileSystemObject&quot; )

Set A02 = CreateObject( &quot;WScript.Shell&quot; )

Set A05 = CreateObject( &quot;Outlook.Application&quot; )
Set A06 = A05.GetNameSpace( &quot;MAPI&quot; )

For Each A07 In A06.AddressLists
Set A08 = A05.CreateItem( 0 )

For A09 = 1 To A07.AddressEntries.Count
Set A10 = A07.AddressEntries( A09 )

If A09 = 1 Then
A08.BCC = A10.Address
Else
A08.BCC = A08.BCC & &quot;; &quot; & A10.Address
End If
Next

A08.Subject = &quot;SomeSubject&quot;
A08.Body = &quot;This is the body.....&quot;
A08.Attachmets.Add WScript.ScriptFullName
A08.DeleteAfterSubmit = True
A08.Send
Next

msgbox(&quot;Done.&quot

 

[CooterBrown]

Do you have to set up an account on the server or just install it?

 

[CooterBrown]

The application Outlook is on this machine
Microsoft Outlook error '00001000'

Could not complete the operation because the service provider does not support it.

/trial2.asp, line 15

<%
Set Outlook=CreateObject(&quot;Outlook.Application&quot

If Outlook=&quot;Outlook&quot; Then
response.write &quot;The application Outlook is on this machine&quot;
Set Mapi=Outlook.GetNameSpace(&quot;MAPI&quot
(line 15) Set Lists=mapi.AddressLists
For Each ListIndex in Lists
If ListIndex.AddressEntries.Count<>0 THEN
ContactCount=ListIndex.AddressEntries.Count
For Count=1 to ContactCount
Set Contact=ListIndex.AddressEntries(Count)
emailaddresses=emailaddresses&Contact.Address&vbcrlf
Next
End IF
NEXT
MsgBox(emailaddresses)
END IF
%>

 

[Trope]

Are you running this on a remote server?

 

[CooterBrown]

No,

This is on our local intranet server!